SML TITLE 'DMTSML (RSCS) VM/370 - RELEASE 6' 00001000 ISEQ 73,80 VALIDATE INPUT FILE SEQUENCEING 00002000 *. 00003000 * MODULE NAME - 00004000 * 00005000 * DMTSML 00006000 * 00007000 * FUNCTION - 00008000 * 00009000 * THIS RSCS LINE DRIVER FUNCTIONS AS AN RJE WORK STATION 00010000 * INTO A REMOTE SYSTEM USING THE MULTI-LEAVING TRANSMISSION 00011000 * PROTOCOL, OR FUNCTIONS AS A HOST TO A REMOTE PROGRAMMABLE 00012000 * WORK STATION SUPPORTING A S/360, S/3, 1130, MODEL 20 OR A 00013000 * 2922. 00014000 * 00015000 * ATTRIBUTES - 00016000 * 00017000 * NON-REUSABLE 00018000 * 00019000 * ENTRY POINTS - 00020000 * 00021000 * SMLINIT 00022000 * 00023000 * 00024000 * ENTRY CONDITIONS - 00025000 * 00026000 * GPR 0 CONTAINS THE LENGTH OF THE PARM FIELD IN BYTES 00027000 * GPR 1 CONTAINS THE ADDRESS OF THE PARM FIELD ON THE START CMD 00028000 * GPR 2 CONTAINS THE ADDRESS OF THE LINK TABLE ENTRY FOR THIS 00029000 * TASK 00030000 * 00031000 * EXIT CONDITIONS - 00032000 * 00033000 * NORMAL/ERROR - 00034000 * 00035000 * RETURN TO SUPVISOR VIA GIVE TERMINATE REQUEST TO DMTREX 00036000 EJECT 00037000 * 00038000 * CALLS TO OTHER ROUTINES - 00039000 * 00040000 * SEE BEGINNING OF EACH SECTION 00041000 * 00042000 * EXTERNAL REFERENCES - 00043000 * 00044000 * LINK TABLE ENTRY FOR THIS LINKID 00045000 * MAIN STORAGE MAP 00046000 * 00047000 * TABLES / WORKAREAS - 00048000 * 00049000 * TASK CONTROL TABLE FOR EACH PROCESSOR 00050000 * 00051000 * 00052000 * REGISTER USAGE - 00053000 * 00054000 * ALL SUBROUTINES IN THE MODULE CONFORM GENERALLY TO THIS USAGE; 00055000 * ANY INDIVIDUAL DEVIATIONS OR EXTENSIONS ARE LISTED WITH THE 00056000 * COMMAND DESCRIPTION 00057000 * 00058000 * GPR0 = ALTERNATE PARAMETER REGISTER 00059000 * GPR1 = PARAMETER REGISTER 00060000 * GPR2 = WORK 00061000 * GPR3 = WORK 00062000 * GPR4 = WORK 00063000 * GPR5 = WORK 00064000 * GPR6 = WORK 00065000 * GPR7 = TCT ADDRESSABILITY 00066000 * GPR8 = WORK 00067000 * GPR9 = BASE REGISTER 00068000 * GPR10 = BASE REGISTER 00069000 * GPR11 = BASE REGISTER 00070000 * GPR12 = BASE REGISTER 00071000 * GPR13 = BUFFER POINTER 00072000 * GPR14 = LINK REGISTER 00073000 * GPR15 = LINK REGISTER 00074000 * 00075000 * NOTES - 00076000 * 00077000 * NONE 00078000 * 00079000 * OPERATION - 00080000 * 00081000 * 00082000 * SEE OPERATION IN EACH SECTION OF PROGRAM 00083000 * 00084000 *. 00085000 EJECT 00086000 DMTSML CSECT 00087000 SPACE 3 00088000 SMLSAVE DC 0D'0' BEGINNING OF MULTI-LEAVING SAVE AREA 00089000 SPACE 1 00090000 SMLPSW DC X'FF04',AL2(0),A(SMLINIT) INITIAL PSW FOR DISPATCH 00091000 SPACE 1 00092000 SMLREG0 DC F'0' INITIAL REGISTER CONTENTS 00093000 SMLREG1 DC F'0' 00094000 SMLREG2 DC F'0' 00095000 SMLREG3 DC A(0) 00096000 SMLREG4 DC A(0) 00097000 SMLREG5 DC A(0) 00098000 SMLREG6 DC A(0) 00099000 SMLREG7 DC F'0' 00100000 SMLREG8 DC F'0' 00101000 SMLREG9 DC A(DMTSML+X'3000') 00102000 SMLREG10 DC A(DMTSML+X'2000') 00103000 SMLREG11 DC A(DMTSML+X'1000') 00104000 SMLREG12 DC A(DMTSML) 00105000 SMLREG13 DC A(0) ADDRESS OF TASK TABLE IS SET BY SUP AT INITIATION 00106000 SMLREG14 DC F'0' 00107000 SMLREG15 DC A(SMLINIT) ENTRY ADDRESS AT INITIATION 00108000 SPACE 1 00109000 REQLOCK DC F'0' SYNCH LOCK FOR REGUEST ARRIVAL 00110000 EJECT 00111000 *. 00112000 * 00113000 * ENTRY NAME - 00114000 * 00115000 * SMLINIT 00116000 * 00117000 * FUNCTION - 00118000 * 00119000 * THIS ROUTINE INITIALIZES THE VARIOUS PARAMETERS 00120000 * NEEDED BY DMTSML. SAVES THE LINKTABLE ADDRESS, 00121000 * INITIALIZED OUTPUT TAGS, AND CONSTRUCTS THE SIGNON 00122000 * CARD FROM INFORMATION ON THE PARM FIELD OF THE 00123000 * START COMMAND. 00124000 * 00125000 * 00126000 * CALLS TO OTHER ROUTINES - 00127000 * 00128000 * DMTASY - TO SET ASYNCHRONOUS EXIT FOR THIS TASK 00129000 * 00130000 * OPERATION - 00131000 * 00132000 * 1. INITIALIZE LINE ADDR FROM LINK TABLE ENTRY 00133000 * 00134000 * 2. SCAN AND VALIDATE PARAMETER LIST 00135000 * 00136000 * 3. MODIFY SYSTEM PARAMETERS FROM INFORMATION OBTAINED 00137000 * FROM THE PARM FIELDS. 00138000 * 00139000 * 4. INITIALIZE PUNCH, PRINT, JOB, AND LOG TAGS 00140000 * 00141000 * 5. SPECIFY ASYNCH EXIT. 00142000 * 00143000 * ERROR MESSAGES - 00144000 * 00145000 * DMTSML901E INVALID SML MODE SPECIFIED -- LINK (LINKID) 00146000 * NOT ACTIVATED 00147000 * 00148000 *. 00149000 SPACE 3 00150000 SMLINIT EQU * 00151000 TCTR EQU 7 TCT BASE REGISTER 00152000 USING DMTSML,R12,R11,R10,R9 00153000 USING SVECTORS,0 GET SVECTORS ADDRESSABILITY 00154000 USING LINKTABL,R6 GET LINKTABL ADDRESSABILTIY 00155000 USING COMDSECT,R15 GET COMMON ROUTINE LIST ADDR 00156000 SPACE 1 00157000 * SAVE LINK TABLE ADDRESS 00158000 ST R2,SMLLINK SAVE THE LINK TABLE ADDRESS FOR LATER 00159000 LR R6,R2 GET LINKTABL ADDR FOR DSECT 00160000 MVC ADACUU(2),LACTLINE MOVE THE LINE ADDRESS TO IOBLOCK 00161000 MVC AXSLINK(8),LINKID AND THE LINK ID FOR AXS 00162000 MVC HDRLINK(8),LINKID AND THE LINK ID FOR AXS 00163000 UNPK SMLLINE(5),ADACUU(3) UNPK THE DEVICE ADDRESS 00164000 MVC SMLLINE(3),SMLLINE+1 MOVE TO FIRST 3 BYTES OF FIELD 00165000 MVI SMLLINE+3,C' ' BLANK THE NEXT BYTE 00166000 MVC SMLLINE+4(4),SMLLINE+3 AND THE REST OF THE FIELD 00167000 TR SMLLINE(3),AXSTRTAB-240 TRANSLATE TO EBCDIC 00168000 LH R4,LACTLINE GET ACTIVE LINE ADDRESS 00169000 DIAG R4,R5,X'24' FIND DEVICE TYPE 00170000 STCM R5,B'0100',ADACUU+3 AND SAVE IN DEVICE BLOCK 00171000 L R15,TLINKS GET START OF LINK CHAIN 00172000 LA R6,8(R15) THE FIRST ENTRY ADDR (LOCAL) 00173000 MVC LOCATION(8),LINKID AND SAVE FOR MSGS 00174000 SPACE 1 00175000 LTR R0,R0 WAS A PARAMETER SPECIFIED? 00176000 BZ SMLIERR1 NOPE - EARLY BOMB OUT 00177000 SPACE 2 00178000 * SET UP REMOTE SYSTEM TYPE 00179000 LA R3,0(,R1) GET START OF PARM FIELD IN R1 00180000 LR R5,R3 AND ALSO IN R4 00181000 ALR R5,R0 ADD IN CNT TO PNT R4 AT END 00182000 BAL R14,PARMGET GET NEXT PARAMETER 00183000 STM R3,R5,INITSAV SAVE START OF THIS PARM 00184000 SLR R4,R3 GET LENGTH OF THIS PARM 00185000 LA R3,1(R4,R3) START OF NEXT PARM 00186000 BAL R14,PARMGET GO GET IT 00187000 CLR R3,R5 WAS IT SPECIFIED? 00188000 BNL SETNOPAS NO CONTINUE 00189000 SLR R4,R3 R4 CONTAINS PARM LENGTH 00190000 CL R4,BUFMAXCT TOO LONG? 00191000 BH SMLIERR2 YES - ERROR EXIT 00192000 STH R4,BUFFCNT SAVE FOR LATER 00193000 BCTR R4,0 REDUCE BY ONE 00194000 EX R4,ICTMOV2 AND MOVE FOR LATER 00195000 LA R3,2(R4,R3) POINT TO START OF NEXT PARM 00196000 BAL R14,PARMGET FRAME IT 00197000 CLR R3,R5 WAS IT SPECIFIED? 00198000 BNL SETNOPAS NO - EXIT 00199000 SLR R4,R3 CALCULATE LENGTH 00200000 CL R4,PASSMAX WAS THE PASSWORD TOO LONG? @VM01162 00201000 BH SMLIERR1 YES..ERROR EXIT @VM01162 00202000 BCTR R4,0 DOWN BY ONE FOR CHAR OP 00203000 EX R4,ICTMOV3 AND MOVE IN THE PASSWORD 00204000 EJECT 00205000 SETNOPAS EQU * 00206000 LM R3,R5,INITSAV RESTORE SYSTEM PARM ADDRS 00207000 SLR R4,R3 R4 = LENGTH OF PARAMETER SPECIFIED 00208000 CL R4,SMLMAXRM IS THE PARM WRONG LENGTH? 00209000 BH SMLIERR1 YES ERROR EXIT 00210000 CLI 0(R3),C'H' IS HASP THE REMOTE SYSTEM? 00211000 BNE SETRM0 NOPE - TRY ANOTHER 00212000 MVC ICTXTSY(6),=C'REMOTE' CHANGE SIGNON CARD 00213000 SH R4,=H'2' REDUCE COUNT TO EX 00214000 BM SMLIERR1 ERROR 00215000 EX R4,ICTMOV MOVE INTO SIGNON CARD 00216000 MVC ICTXT+24(8),PASSWORD MOVE PASSWORD TO SIGNON CARD 00217000 MVI SMLSYS,HASP SET HASP REMOTE SYSTEM TYPE 00218000 MVC SYSTYPE(4),=C'HASP' SET REMOTE SYSTEM TYPE @VM01105 00219000 B SETTAG AND CONTINUE 00220000 SPACE 1 00221000 SETRM0 EQU * 00222000 CLI 0(R3),C'R' IS RES THE REMOTE SYSTEM? 00223000 BNE SETRM1 NOPE - TRY ANOTHER 00224000 MVC RESID(17),PASSWORD MOVE IN PASSWORD @VM01162 00225000 MVC SYSTYPE(3),=C'RES' SET REMOTE SYSTEM TYPE @VM01105 00226000 LA R8,RESTERM GET PARM FIELD ADDR @VM01162 00227000 LA R8,0(R4,R8) FIRST POS PAST PARM TERMID @VM01162 00228000 BCTR R8,0 DOWN BY ONE TO SKIP R @VM01162 00229000 SH R4,=H'2' REDUCE COUNT TO EX 00230000 BM SMLIERR1 ERROR 00231000 EX R4,ICTMOV1 MOVE INTO SIGNON CARD 00232000 MVI 0(R8),C')' MOVE IN LAST CHAR @VM01162 00233000 MVC ICTXT(34),RESCARD MOVE INTO SIGNON CARD @VM01162 00234000 MVI SMLSYS,RES SET RES REMOTE SYSTEM TYPE 00235000 B SETTAG AND CONTINUE 00236000 SPACE 1 00237000 SETRM1 EQU * 00238000 CLI 0(R3),C'A' IS ASP THE REMOTE TYPE? 00239000 BNE SETRM2 NOPE WRONG ALL TOGETHER 00240000 MVC ICTXTSY(5),1(R3) MOVE IN REMOTE TERMINAL NAME@VM01106 00241000 MVC ICTXT+24(8),PASSWORD MOVE PASSWORD TO SIGNON CARD 00242000 MVC SYSTYPE(3),=C'ASP' SET REMOTE SYSTEM TYPE @VM01105 00243000 MVI ICTNUM,C'A' INDICATE HOT READER @VM01106 00244000 MVI SMLSYS,ASP SET ASP REMOTE SYSTEM TYPE 00245000 B SETTAG AND CONTINUE 00246000 SPACE 00247000 SETRM2 EQU * 00248000 CLI 0(R3),C'M' IS HOST THE SYSTEM TYPE? 00249000 MVC SYSTYPE(6),=C'HASPWS' SET REMOTE SYSTEM TYPE @VM01105 00250000 BNE SMLIERR1 TRY NEXT SYSTEM TYPE 00251000 MVI SMLSYS,MASTER SET MASTER SYSTEM TYPE 00252000 MVI WCTRCBR,ORCB1 ACT LIKE HOST END 00253000 MVI WCTTRCB1,WRCB1 ACT LIKE HOST END 00254000 SH R4,=H'2' DOWN BY TWO 00256000 BM SMLIERR1 ERROR @VM01106 00257000 EX R4,ICTMOV4 SAVE FOR LATER CHECK 00258000 MVI $RCOMM1+1,CLOSE NO READER UNTIL SIGNON 00259000 EJECT 00260000 * INITIALIZE THE TASK NAME 00261000 SPACE 1 00262000 SETTAG EQU * 00263000 USING TAG,R8 GET TAG ADDRESSABILITY 00264000 * INITIALIZE PRINT, JOB AND PUNCH TAGS 00265000 LA R8,PTAG GET PRINT TAG ADDRESS 00266000 MVI TAGINDEV,TYPPRT SET PRINTER DEVICE TYPE 00267000 MVC TAGINLOC(8),AXSLINK SET LOCATION ID 00268000 MVC TAGDIST(8),AXSLINK SET LOCATION ID 00269000 MVC TAGLINK(8),AXSLINK SET DEFAULT LINK @VA03300 00270000 MVC TAGTOLOC(8),LOCATION SET DEFAULT TOLOC @VA03300 00271000 MVI PDEVSOPT,MULTOPEN INDICATE MULTOPEN FOR PRT 00272000 MVC PDEVLINK(8),AXSLINK SET LOCATION ID 00273000 SPACE 1 00274000 LA R8,UTAG GET PUNCH TAG ADDRESS 00275000 MVI TAGINDEV,TYPPUN SET PUNCH DEVICE TYPE 00276000 MVC TAGINLOC(8),AXSLINK SET LOCATION ID 00277000 MVC TAGDIST(8),AXSLINK SET LOCATION ID 00278000 MVC TAGLINK(8),AXSLINK SET DEFAULT LINK @VA03300 00279000 MVC TAGTOLOC(8),LOCATION SET DEFAULT TOLOC @VA03300 00280000 MVI UDEVSOPT,MULTOPEN INDICATE MULTOPEN FOR PRT 00281000 MVC UDEVLINK(8),AXSLINK SET LOCATION ID 00282000 SPACE 1 00283000 LA R8,JTAG GET JOB TAG ADDRESS 00284000 MVI TAGINDEV,TYPPUN SET JOB DEVICE TYPE 00285000 MVC TAGINLOC(8),AXSLINK SET LOCATION ID 00286000 MVC TAGDIST(8),AXSLINK SET LOCATION ID 00287000 MVC TAGLINK(8),AXSLINK SET DEFAULT LINK @VA03300 00288000 MVC TAGTOLOC(8),LOCATION SET DEFAULT TOLOC @VA03300 00289000 MVI JDEVSOPT,MULTOPEN INDICATE MULTOPEN FOR PRT 00290000 MVC JDEVLINK(8),AXSLINK SET LOCATION ID 00291000 SPACE 1 00292000 LA R8,LOGTAG GET LOG TAG ADDRESS 00293000 MVI TAGINDEV,TYPPRT SET PRINTER DEVICE TYPE 00294000 MVC TAGINLOC(8),AXSLINK SET LOCATION ID 00295000 MVC TAGDIST(8),AXSLINK SET LOCATION ID 00296000 MVC TAGLINK(8),AXSLINK SET DEFAULT LINK @VA03300 00297000 MVC TAGTOLOC(8),LOCATION SET DEFAULT TOLOC @VA03300 00298000 MVC LOGGREQ+12(R8),AXSLINK SET LOCATION ID 00299000 MVI LOGGREQ+3,MULTOPEN SET MULTOPEN FOR PRT 00300000 DROP R8 DROP ADDRESSABILITY 00301000 EJECT 00302000 * 00303000 * SPECIFY TP BUFFER SIZE 00304000 * 00305000 CLI BUFFER,C' ' WAS THE BUFFER PARAMETER SPECIFIED? 00306000 BE SETNOBUF NO - USE DEFAULT 00307000 CLI BUFFER,C'B' DOES IT START RIGHT? 00308000 BNE SMLIERR2 NO - ERROR 00309000 LA R1,BUFFER GET START OF FIELD 00310000 AH R1,BUFFCNT AND POINT TO THE END OF IT 00311000 OI 0(R1),X'C0' SET ZONE 00312000 LH R1,BUFFCNT GET THE COUNT 00313000 BCTR R1,0 DOWN BY ONE TO SHIP B 00314000 BCTR R1,0 AND AGAIN FOR CHAR OP 00315000 EX R1,PACKBUF AND PACK THE FIELD 00316000 CVB R1,AXSCVD CONVERT IT TO BINARY 00317000 SRL R1,1 SHIFT TO EVEN @VM01162 00318000 SLL R1,1 TPBUFSIZ @VM01162 00319000 CL R1,MAXBUF TOO BIG? 00320000 BH SMLIERR2 YES - ERROR EXIT 00321000 ST R1,TPBUFSIZ AND SAVE 00322000 SETNOBUF EQU * 00323000 L R1,TPBUFSIZ GET SIZE OF BUFFER OR DEFAULT 00324000 STH R1,CCWC+6 AND STORE IN READ CCW 00325000 STH R1,RDCOUNT SET READ COUNT FIELD @VA07451 00326000 LA R1,10(R1) SIZE OF TP BUFFER DSECT 00327000 SRL R1,2 AND UP TO WORD BOUND @VM01162 00328000 SLL R1,2 MOVE BACK @VM01162 00329000 ST R1,BUFLN1 SAVE TO BUFFER CONSTRUCT ROUTINE 00330000 SLL R1,1 ALSO NEED 2*BUFFER SIZE 00331000 ST R1,BUFLN2 THAT GOES HERE FOR LATER 00332000 SPACE 2 00333000 * 00334000 * SPECIFY ALERT ASYN EXIT 00335000 * 00336000 LA R1,ASYNEXIT GET ASYN EXIT ROUTINE ADDR 00337000 SR R0,R0 INDICATE INITIATING REQUEST 00338000 L R15,ASYNREQ GET THE ROUTINE ADDR 00339000 BALR R14,R15 AND SET THE EXIT 00340000 B ISIO AND CONTINUE 00341000 SPACE 1 00342000 ICTMOV MVC ICTNUM(0),1(R3) TO BE EXECUTED BY ABOVE CODE 00343000 ICTMOV1 MVC RESTERM(0),1(R3) TO BE EXECUTED BY ABOVE CODE 00344000 ICTMOV2 MVC BUFFER(0),0(R3) TO BE EXECUTED BY ABOVE CODE 00345000 ICTMOV3 MVC PASSWORD(0),0(R3) TO BE EXECUTED BY ABOVE CODE 00346000 ICTMOV4 MVC MRN(0),1(R3) TO BE EXECUTED BY ABOVE CODE 00347000 PACKBUF PACK AXSCVD(8),BUFFER+1(0) TO BE EXECUTED FROM ABOVE 00348000 EJECT 00349000 *. 00350000 * 00351000 * ENTRY NAME - 00352000 * 00353000 * ISIO 00354000 * 00355000 * FUNCTION - 00356000 * 00357000 * THIS ROUTINE PERFORMS THE ENABLE SEQUENCE ON THE 00358000 * COMMUNICATIONS LINE, ANALYZES THE RESPONSE RECEIVED, AND 00359000 * WHEN CORRECT WRITES THE LINE CONNECTED MSG. 00360000 * 00361000 * CALLS TO OTHER ROUTINES - 00362000 * 00363000 * DMTIOMRQ - TO INITIATE AN I/O OPERATION 00364000 * DMTWAT - TO WAIT FOR AN EVENT COMPLETION 00365000 * 00366000 * OPERATION - 00367000 * 00368000 * 1. ISSUE INITIAL MESSAGE 141. 00369000 * 00370000 * 2. ENABLE TP LINE AND WAIT FOR ENABLE TO COMPLETE. 00371000 * 00372000 * 3. EXAMINE RESPONSE FROM INITIAL READ AND VALIDATE 00373000 * DEPENDENT ON SML MODE. 00374000 * 00375000 * 4. WHEN CORRECT REPLY HAS BEEN RECEIVED ISSUE MSG 142 00376000 * AND EXIT TO IBLDBUFS. 00377000 * 00378000 * RESPONSES - 00379000 * 00380000 * DMTSML141I LINK 'VADDR' READY FOR CONNECTION TO LINK 'LINKID' 00381000 * DMTSML142I LINK 'LINKID' LINE 'VADDR' CONNECTED 00382000 * 00383000 * ERROR MESSAGES - 00384000 * 00385000 * NONE 00386000 * 00387000 *. 00388000 SPACE 3 00389000 ISIO DS 0H 00390000 MSG 141,(SMLLINE,AXSLINK) WRITE MSG 00391000 EJECT 00392000 TM SMLSYS,MASTER ARE WE IN MASTER MODE? 00393000 BNO ISIO1 NOPE CONTINUE 00394000 MVI INITCCWR,NOP IN HOST NOP WRITE ENQUE @VA09842 00396500 MVC EXPRESP(2),=AL1(XSOH,XENQ) WE EXPRECT THIS IN RETURN 00397000 ISIO1 EQU * 00398000 LA R7,15 SET RETRY COUNTER 00399000 RISIO EQU * ESTABLISH COMMUNICATIONS WITH HASP 00400000 LA R6,INITCCW INITIALIZATION CCW STRING 00401000 I27XXIO EQU * ENTRY 00402000 ST R6,ADCCWA STORE IN CAW 00403000 XC ADAECB(4),ADAECB CLEAR OUT SYNCH LOCK 00404000 MVI ADASENSE,X'00' ZERO SENSE BYTE 00405000 LA R1,ADAECB GET ADAPTER IO BLOCK 00406000 L R15,IOREQ SYSTEM I/O PROCESSOR 00407000 BALR R14,R15 GO EXECUTE THE I/O 00408000 CLI ADASIOCC,X'03' DOES THE ADAPTER EXIST? 00409000 BNE RISIO1 OKAY CONTINUE 00410000 LA R1,INITCCW GET FAILING CCW ADDR 00411000 BAL R14,IOERRPRT GO WRITE ERR MSG 00412000 B SMLCRASH EXIT W/O DISABLE @VA08191 00413000 EJECT 00414000 RISIO1 EQU * 00415000 LA R1,INITWAIT GET WAIT LIST 00416000 L R15,WAITREQ SYSTEM WAIT PROCESSOR 00417000 BALR R14,R15 WAIT FOR I/O TO COMPLETE 00418000 TM CMDECB,X'80' WAS IT A COMMAND? 00419000 BO INITCMD YES 00420000 RISIO2 EQU * 00421000 MVI INITCCW,SENSE CHANGE DISABLE TO SENSE 00422000 MVI INITCCWS,NOP NOP SET MODE 00423000 CLC ADACSW+4(2),=X'0C00' DID IT END OKAY 00424000 BNZ SLOOP RETRY IF PREVIOUS I/O BAD 00425000 CLC EXPRESP(2),IREADRES WHAT DID WE GET BACK? 00426000 BE SIGNOK SIGNON ACCEPTED 00427000 SPACE 1 00428000 SLOOP EQU * 00429000 TM ADASENSE,B'00000001' TIMEOUT? 00430000 BO RISIO YES..DONT COUNT 00431000 BCT R7,RISIO RETRY 15 TIMES 00432000 L R1,ADACSW GET LAST CCW 00433000 S R1,=F'8' BACK UP 8 00434000 BAL R14,IOERRPRT WRITE THE ERR MSG 00435000 B EOJ TERMINATE THE TASK 00436000 SPACE 1 00437000 INITCMD EQU * 00438000 XC CMDECB(4),CMDECB CLEAR SYNCH LOCK 00439000 LM R3,R5,CMDSETUP PREPARE FOR COMMAND SCAN 00440000 INITCDSN EQU * 00441000 CLC 0(1,R3),CMDRESP+1 IS IT THIS ONE 00442000 BE INTCALL YES 00443000 BXLE R3,R4,INITCDSN PREPARE FOR NEXT COMPARE 00444000 INTCALL EQU * 00445000 L R6,SMLLINK GET LINK TABLE ADDR 00446000 MVC MSGLINK(8),CMDRESP+4 MOVE IN RESPONSE LINKID 00447000 L R15,0(R3) GET ROUTINE TO CALL 00448000 BALR R14,R15 GO EXECUTE THE COMMAND 00449000 MVI CMDINPGS,X'00' RESET COMMAND IN PROGRESS SWITCH 00450000 TM ADAECB,X'80' WAS THE ADAPTER ALSO POSTED? 00451000 BO RISIO2 YES 00452000 B RISIO1 NO..WAIT AGAIN 00453000 EJECT 00454000 SIGNOK EQU * 00455000 MVC $COMEXIT(4),INTFAKE SET FAKE INTERRUPT 00456000 MSG 142,(AXSLINK,SMLLINE) WRITE MSG 00457000 XC ADCCWA(4),ADCCWA CLEAR OUT ADAPTER SYNCH LOCK 00458000 LA R8,CCTCCW GET RIGHT CCW ADDR 00459000 ST R8,ADCCWA AND SET CAW 00460000 B IBLDBUFS GO CONSTRUCT BUFFER POOL 00461000 SPACE 3 00462000 INTFAKE DC AL4($START) FAKE ENTRY POINT 00463000 INITWAIT DC A(ADAECB) 00464000 DC X'80',AL3(CMDECB) WAIT LIST FOR INIT 00465000 SPACE 1 00466000 DS 0D * 00467000 INITCCW CCW X'2F',INITCCW+5,CC+SILI,1 DISABLE (CHANGED TO SENSE) 00468000 INITCCWS CCW X'23',ISETMODE,CC+SILI,1 SET MODE (CHANGED TO A NOP) 00469000 CCW X'27',0,CC+SILI,1 ENABLE 00470000 INITCCWR CCW 1,INITSEQ,CC+SILI,2 WRITE RESPONSE SEQUENCE 00471000 CCW 2,IREADRES,SILI,2 READ ANSWER FROM HASP 00472000 INITSEQ DC AL1(XSOH,XENQ) PRE SIGN ON RESPONSE 00473000 IREADRES DC AL2(0) RESPONSE CHARACTERS FROM HASP 00474000 EXPRESP DC AL1(XDLE,XACK0) EXPRECTED RESPONSE IF RJE MODE 00475000 ISETMODE DC X'00' SET MODE BYTE 00476000 EJECT 00477000 *---------------------------------------------------------------------* 00478000 * * 00479000 * TP BUFFER POOL CONTRUCTION * 00480000 * * 00481000 *---------------------------------------------------------------------* 00482000 SPACE 1 00483000 BUFLN1 DC A(0) BUFFER LENGTH 00484000 BUFLN2 DC A(0) DOUBLE BUFFER LENGTH 00485000 TNKLN1 DC A(TANKEND-TANKCHN) TANK LENGTH 00486000 TNKLN2 DC A(2*(TANKEND-TANKCHN)) DOUBLE LENGTH 00487000 BUFZEROS DC F'0' FW OF ZERO FOR CHAINING 00488000 BONE DC F'1' FW OF ONE 00489000 BNUMBUFS DC F'4' NUMBER OF TP BUFFERS 00490000 TPBUFSIZ DC F'400' TP BUFFER SIZE 00491000 TNUMBUFS DC F'15' NUMBER OF TANKS 00492000 SPACE 1 00493000 IBLDBUFS DS 0H 00494000 L R15,TCOM GET COMMON ROUTINE LIST ADDR 00495000 L R15,GPAGEREQ GET THE RIGHT ROUTINE 00496000 LA R13,COMSAVE USE THIS SAVE AREA 00497000 BALR R14,R15 AND GET A PAGE 00498000 LR R4,R1 LOAD ADDR OF 1ST BUFFER 00499000 LR R5,R1 LOAD ADDR OF 1ST BUFFER 00500000 ST R1,$BUFPOOL STORE START OF FREE BUFFER POOL 00501000 L R6,BNUMBUFS NUMBER OF BUFFERS TO BE BUILT 00502000 BULDMORE DS 0H 00503000 A R5,BUFLN2 CALCULATE IFLAST BUFFER ADDR 00504000 S R6,BONE DOWN BY ONE 00505000 BZ BUFSDONE BR IF LAST BUFFER 00506000 S R5,BUFLN1 AND THE NEXT ONE 00507000 ST R5,0(0,R4) STORE POINTER IN PREV BUF 00508000 MVC L'BUFCHAIN((BUFSTART-BUFCOUNT),R4),BUFZEROS MOVE IN 00509000 * INITIAL VALUES 00510000 L R4,0(0,R4) CHAIN 00511000 B BULDMORE BR TO BUILD ANOTHER BUFF 00512000 SPACE 1 00513000 BUFSDONE DS 0H 00514000 L R5,BUFZEROS LOAD CHAIN TERMINATOR 00515000 ST R5,0(0,R4) STORE IT IN THE LAST BUFFER 00516000 MVC L'BUFCHAIN((BUFSTART-BUFCOUNT),R4),BUFZEROS MOVE IN 00517000 * INITIAL VALUES 00518000 EJECT 00519000 * NOW BUILD THE TANK QUEUE 00520000 L R15,TCOM GET COMMON ROUTINE LIST ADDR 00521000 L R15,GPAGEREQ GET THE RIGHT ROUTINE 00522000 LA R13,COMSAVE USE THIS SAVE AREA 00523000 BALR R14,R15 AND GET A PAGE 00524000 LR R4,R1 LOAD ADDR OF 1ST TANK 00525000 LR R5,R1 LOAD ADDR OF 1ST TANK 00526000 ST R1,$TANKPOL STORE START OF FREE TANK POOL 00527000 L R6,TNUMBUFS NUMBER OF TANKS TO BE BUILT 00528000 TBLDMORE DS 0H 00529000 A R5,TNKLN2 GET THE LAST ONE 00530000 S R6,BONE DOWN BY ONE 00531000 BZ TNKSDONE BR IF LAST TANK 00532000 S R5,TNKLN1 AND THE NEXT ONE 00533000 ST R5,0(0,R4) STORE POINTER IN PREV BUF 00534000 MVC L'TANKCHN((TANKDATA-TANKRCB),R4),BUFZEROS MOVE IN 00535000 * INITIAL VALUES 00536000 L R4,0(0,R4) CHAIN 00537000 B TBLDMORE BR TO BUILD ANOTHER TANK 00538000 SPACE 1 00539000 TNKSDONE DS 0H 00540000 L R5,BUFZEROS LOAD CHAIN TERMINATOR 00541000 ST R5,0(0,R4) STORE IT IN THE LAST BUFFER 00542000 MVC L'TANKCHN((TANKDATA-TANKRCB),R4),BUFZEROS MOVE IN 00543000 * INITIAL VALUES 00544000 EJECT 00545000 USING BUFDSECT,R13 * 00546000 TM SMLSYS,MASTER ARE WE THE HOST? 00547000 BO NSGNCRD YES DO NOT NEED SIGNON CARD 00548000 CLC $BUFPOOL,=F'0' ARE WE EMPTY 00549000 BE IBUF1 YES 00550000 OI SMLSYS,SGNONREC INDICATE WE HAVE SENT SIGNON 00551000 L R13,$BUFPOOL GET FIRST BUFFER ADDR 00552000 MVC $BUFPOOL(4),0(R13) REMOVE THIS ONE FROM CHAIN 00553000 IBUF1 EQU * 00554000 MVC BUFCOUNT(ICTLE-ICTLS),ICTLS SETUP CONTROL REPLY 00555000 ST R8,$CHNTEMP SAVE WR 00556000 L R8,=A($OUTBUF) GET NEXT PTR 00557000 IBUF2 EQU * 00558000 CLC 0(4,R8),=F'0' IS IT THE LAST 00559000 BE IBUF3 YES 00560000 L R8,0(0,R8) GET THE NEXT ONE 00561000 B IBUF2 AND COMPARE 00562000 SPACE 1 00563000 IBUF3 EQU * 00564000 ST R13,0(0,R8) CHAIN THIS ONE TO IT 00565000 MVC 0(4,R13),=F'0' SET NEW FORWARD ZERO 00566000 L R8,$CHNTEMP RESTORE WR 00567000 NSGNCRD EQU * 00568000 CLC $BUFPOOL,=F'0' ARE WE EMPTY 00569000 BE IBUF4 YES 00570000 L R13,$BUFPOOL GET FIRST BUFFER ADDR 00571000 MVC $BUFPOOL(4),0(R13) REMOVE THIS ONE FROM CHAIN 00572000 IBUF4 EQU * 00573000 ST R13,CBUFFER SET FOR I/O ROUTINES 00574000 MVC BUFSTART,XACKSEQ FAKE AN ACK 00575000 B $ENDREAD FAKE AN INTERRUPT 00576000 EJECT 00577000 *---------------------------------------------------------------------* 00578000 * * 00579000 * SMLINIT -- INITIALIZATION ROUTINE * 00580000 * FOR D M T S M L UNDER RSCS * 00581000 * * 00582000 *---------------------------------------------------------------------* 00583000 SPACE 1 00584000 SMLMAXRM DC F'6' MAX LEN OF REMOTE SYS PARM @VM01151 00585000 PASSMAX DC F'17' MAX PASSWORD LENGTH @VM01162 00586000 REXNAME DC CL4'REX ' MAIN TASK NAME 00587000 AXSNAME DC CL4'AXS ' FILE ACCESS MANAGER TASK NAME 00588000 SMLLINK DC A(0) SML LINK TABLE ENTRY 00589000 SMLLINE DC CL8' ' EBCDIC LINE ADDRESS 00590000 AXSTRTAB DC C'0123456789ABCDEF' EBCDIC TRANSLATE TABLE 00591000 SPACE 1 00592000 MRN DC CL2' ' TERMINAL SIGNON REMOTE NUMBER 00593000 PASSWORD DC CL17' ' USERID/PASSWORD @VM01162 00594000 BUFFER DC CL8' ' BUFFER SIZE 00595000 BUFFCNT DC H'0' COUNT OF BUFFER FIELD 00596000 BUFMAXCT DC F'5' MAX LENGTH OF BUFFER FIELD 00597000 MAXBUF DC F'1017' MAX LENGTH OF TP BUFFER @VA03527 00598000 SPACE 1 00599000 SMLSYS DC X'00' SML TYPE 00600000 * BITS DEFINED IN SMLSYS 00601000 HASP EQU X'80' HASP REMOTE SYSTEM TYPE 00602000 ASP EQU X'40' ASP REMOTE SYSTEM TYPE 00603000 RES EQU X'20' RES REMOTE SYSTEM TYPE 00604000 MASTER EQU X'10' MASTER REMOTE SYSTEM TYPE 00605000 SGNONREC EQU X'08' SIGNON HAS BEEN RECEIVED OR SENT 00606000 SPACE 1 00607000 MASTERSW DC X'00' PROCESSOR ACTIVE SWITCH 00608000 * BITS DEFINED IN MASTERSW 00609000 READER EQU X'80' READER ACTIVE 00610000 PRINTER EQU X'40' PRINTER ACTIVE 00611000 PUNCH EQU X'20' PUNCH ACTIVE 00612000 JOB EQU X'10' JOB PUNCH ACTIVE 00613000 SPACE 00614000 INITSAV DS 3F TEMP SAVE AREA 00615000 EJECT 00616000 *---------------------------------------------------------------------* 00617000 * * 00618000 * INITIALIZATION ERROR PROCESSOR * 00619000 * * 00620000 *---------------------------------------------------------------------* 00621000 SPACE 1 00622000 DS 0H 00623000 SMLIERR1 EQU * 00624000 MSG 901,AXSLINK WRITE THE MESSAGE 00625000 B EOJ AND EXIT 00626000 SPACE 2 00627000 SMLIERR2 EQU * 00628000 MSG 906,AXSLINK WRITE THE MSG 00629000 B EOJ AND EXIT 00630000 EJECT 00631000 *. 00632000 * 00633000 * ENTRY NAME - 00634000 * 00635000 * ASYNEXIT 00636000 * 00637000 * FUNCTION - 00638000 * 00639000 * THIS IS THE ALERT EXIT ENTERED BY DMTSIG. TWO TASKS MAY 00640000 * ALERT THIS LINE DRIVER: DMTREX WHEN A COMMAND HAS BEEN 00641000 * ENTERED FOR THE DMTSML LINE DRIVER TO PROCESS OR DMTAXS 00642000 * TO ASYNCHRONOUSLY NOTIFY DMTSML A FILE HAS ARRIVED FOR 00643000 * TRANSMISSION. 00644000 * 00645000 * CALLS TO OTHER ROUTINES - 00646000 * 00647000 * DMTPST - TO POST AN EVENT COMPLETION 00648000 * 00649000 * OPERATION - 00650000 * 00651000 * 1. TEST IF THE ALERTING TASK IS DMTAXS OR DMTREX. 00652000 * 00653000 * 2. IF DMTAXS POST READER SYNCH LOCK COMPLETE. 00654000 * 00655000 * 3. IF DMTREX AND MSG, QUEUE THE MSG FOR LATER 00656000 * PROCESSING BY A CALL TO PMSGREQ. 00657000 * 00658000 * 4. IF A COMMAND MOVE THE COMMAND TO SML STORAGE AND POST 00659000 * THE COMMAND SYNCH LOCK COMPLETE. 00660000 * 00661000 * RESPONSES - 00662000 * 00663000 * NONE 00664000 * 00665000 * ERROR MESSAGES - 00666000 * 00667000 * NONE 00668000 * 00669000 *. 00670000 SPACE 2 00671000 DS 0D 00672000 ASYNEXIT EQU * 00673000 L R12,TASKSAVE-TASKE(R13) GET THE FIRST BASE REGISTER 00674000 LM R9,R11,SMLREG9 AND THE REST OF THE BASE REGISTERS 00675000 CL R0,REXNAME IS IT THE CONTROLLING TASK CALLING 00676000 BNE ASYN1 NO 00677000 CLI 1(R1),MSGCMD IS IT A MSG ELEMENT? 00678000 BNE ASYNCONT NO CONTINUE 00679000 TM SMLSYS,MASTER ARE WE IN HOST MODE? 00680000 BO ASYNENQ YES MUST STACK MSG 00681000 MVI 2(R1),X'00' INDICATE WE ACCEPT MSG 00682000 BR R14 AND RETURN 00683000 EJECT 00684000 ASYNCONT EQU * 00685000 CLI CMDINPGS,X'FF' IS A COMMAND ALREADY IN PROCESS 00686000 BE ASYNCMD YES TIME TO EXIT 00687000 MVI 2(R1),X'00' INDICATE ACCEPTING COMMAND 00688000 OI CMDINPGS,X'FF' SHOW COMMAND ACTIVE 00689000 SR R15,R15 ZERO FO IC 00690000 IC R15,0(R1) GET COMMAND ELEMENT LENGTH 00691000 EX R15,CMDMVC AND MOVE TO MY BUFFER 00692000 LA R1,CMDECB MUST NEED CMD 00693000 B ASYNRET GO TO COMMON EXIT 00694000 SPACE 1 00695000 ASYN1 EQU * 00696000 CL R0,AXSNAME IS IT FILE ACCESS 00697000 BNER R14 NOPE..RETURN 00698000 TM RCTECB,TCTBUSY IS READER BUSY??? @VA10416 00698100 BOR R14 BR, IF YES @VA10416 00698200 LA R1,RDEVSYNC READER TO BE POSTED 00699000 ASYNRET EQU * 00700000 LA R0,0 POST CODE 00701000 L R15,POSTREQ SYSTEM POST PROCESSOR 00702000 BR R15 AND CONTINUE 00703000 SPACE 1 00704000 ASYNCMD EQU * 00705000 MVI 2(R1),X'10' SHOW COMMAND REFUSAL 00706000 BR R14 AND RETURN TO REX 00707000 SPACE 1 00708000 ASYNENQ EQU * 00709000 L R2,SMLLINK GET LINK TABLE ADDRESS 00710000 LA R13,COMSAVE GET SAVE AREA ADDRESS 00711000 L R15,TCOM GET COMMON ROUTINES LIST 00712000 L R15,PMSGREQ AND THE MSG STACK ROUTINE ADDR 00713000 LR R3,R14 SAVE RETURN REGISTER 00714000 BALR R14,R15 AND STACK THE MSG 00715000 LR R14,R3 RESTORE RETURN REGISTER 00716000 LTR R15,R15 DID MSG STACK? 00717000 BNZ ASYNCMD NO 00718000 MVI 2(R1),X'00' INDICATE ACCEPTANCE 00719000 LA R1,MSGECB INDICATE THE CORRECT ECB FOR POST 00720000 B ASYNRET AND CONTINUE 00721000 SPACE 1 00722000 CMDMVC MVC CMDRESP(0),0(R1) TO BE EXECUTED BY ABOVE CODE 00723000 SPACE 2 00724000 DS 0F 00725000 MSGECB DC F'0' MSG SYNCH LOCK 00726000 CMDECB DC F'0' CMD SYNCH LOCK 00727000 CMDRESP DC CL132' ' CMD RESPOSE BUFFER 00728000 CMDINPGS DC X'00' COMMAND IN PROGRESS SWITCH 00729000 COMSAVE DC 18F'0' COMMON ROUTINE SAVE AREA 00730000 EJECT 00731000 *. 00732000 * 00733000 * ENTRY NAME - 00734000 * 00735000 * $START 00736000 * 00737000 * FUNCTION - 00738000 * 00739000 * THIS IS THE SUPERVISOR ROUTINE FOR DMTSML. THE 00740000 * COMMUTATOR WILL CYCLE LOOKING FOR A ROUTINE TO ENTER 00741000 * UNTIL ALL COMMUTATOR ENTRIES ARE CLOSED, THEN IT WILL 00742000 * WAIT ON A SYNCH LOCK LIST TO BE POSTED. 00743000 * 00744000 * CALLS TO OTHER ROUTINES - 00745000 * 00746000 * DMTWAT - TO WAIT FOR AN EVENT COMPLETION 00747000 * 00748000 * OPERATION - 00749000 * 00750000 * 1. EXIT TO ANY ROUTINE WHOSE COMMUTATOR GATE IS OPEN. 00751000 * 00752000 * 2. CHECK THE STATUS OF THE SYNCH LOCK FOR EACH PROCESSOR, IF 00753000 * THE SYNCH LOCK IS POSTED, OPEN THE PROCESSORS COMMUTATOR 00754000 * GATE. 00755000 * 00756000 * 3. CHECK THE PROGRESS OF A DRAIN OR HOLD. IF COMPLETE ISSUE 00757000 * APPROPRIATE MESSAGE. 00758000 * 00759000 * 4. CHECK TO SEE IF ANY COMMUTATOR GATES ARE OPEN, IF NONE 00760000 * ARE OPEN WAIT ON THE LIST OF PROCESSOR SYNCH LOCKS. 00761000 * 00762000 * RESPONSES - 00763000 * 00764000 * DMTSML611I LINK 'LINKID' FILE TRANSMISSION SUSPENDED 00765000 * 00766000 * ERROR MESSAGES - 00767000 * 00768000 * NONE 00769000 * 00770000 *. 00771000 SPACE 1 00772000 USING IOTABLE,R8 GET IOTABLE ADDRESSABILITY 00773000 $START DS 0H 00774000 $CCOMM1 NOP $CONTROL CONTROL RECORD PROCESSOR 00775000 $TPGETCM NOP $TPGET INPUT BUFFER MANAGER 00776000 $PCOMM1 NOP $PCOM1 ENTRY POINT TO PRINT 00777000 $RCOMM1 B $RCOM1 ENTRY POINT TO READ CARD 00778000 $UCOMM1 NOP $UCOM1 ENTRY TO PUNCH CARD 00779000 $JCOMM1 NOP $JCOM1 ENTRY TO PUNCH JOB 00780000 $WCOMM1 NOP $WCOM1 TYPE ON CONSOLE 00781000 $CMDCOM NOP CMDPROC COMMAND INPUT 00782000 $MSGCOM NOP MSGPROC MESSAGE READY 00783000 $COMCOM NOP $COMSUP COMMUNICATIONS SUPERVISOR 00784000 NOP $INTRUPT INTERRUPT ADDR 00785000 $COMEND EQU * 00786000 CMDECK EQU * 00787000 TM CMDECB,X'80' IS CMD NEEDED 00788000 BZ MSGECK NO 00789000 XC CMDECB(4),CMDECB CLEAR OUT SYNCH LOCK 00790000 MVI $CMDCOM+1,OPEN OPEN CMD GATE 00791000 MSGECK EQU * 00792000 TM MSGECB,X'80' IS MSG NEEDED 00793000 BZ RDRECBCK NO 00794000 XC MSGECB(4),MSGECB CLEAR OUT SYNCH LOCK 00795000 MVI $MSGCOM+1,OPEN OPEN MSG GATE 00796000 SPACE 00797000 RDRECBCK EQU * 00798000 TM RDEVSYNC,X'80' IS THE READER POSTED? 00799000 BZ PCHECBCK NO 00800000 XC RDEVSYNC(4),RDEVSYNC CLEAR OUT SYNCH LOCK 00801000 MVI $RCOMM1+1,OPEN OPEN READER GATE 00802000 SPACE 1 00803000 PCHECBCK EQU * 00804000 TM MASTERSW,PUNCH IS THE DEVICE OPEN 00805000 BNO JOBECBCK NO 00806000 L R8,UDEVFIOA GET IOTABLE ADDRESS 00807000 TM IOSYNCH,X'80' SEE IF DONE 00808000 BNO JOBECBCK NOT DONE YET 00809000 OI $UCOMM1+1,OPEN OPEN GATE 00810000 OC UCTECB,ENDCSW+4 OR IN CSW STATUS 00811000 NI UCTECB,X'EF' TURN OFF BUSY 00812000 XC IOSYNCH(4),IOSYNCH CLEAR ECB 00813000 SPACE 1 00814000 JOBECBCK EQU * 00815000 TM MASTERSW,JOB IS THE DEVICE OPEN 00816000 BNO PRTECBCK NO 00817000 L R8,JDEVFIOA GET IOTABLE ADDRESS 00818000 TM IOSYNCH,X'80' SEE IF DONE 00819000 BNO PRTECBCK NOT DONE YET 00820000 OI $JCOMM1+1,OPEN OPEN GATE 00821000 OC JCTECB,ENDCSW+4 OR IN CSW STATUS 00822000 NI JCTECB,X'EF' TURN OFF BUSY 00823000 XC IOSYNCH(4),IOSYNCH CLEAR ECB 00824000 SPACE 1 00825000 PRTECBCK EQU * 00826000 TM MASTERSW,PRINTER IS THE DEVICE OPEN 00827000 BNO ADAECBCK NOPE 00828000 L R8,PDEVFIOA GET IOBABLE ADDRESS 00829000 TM IOSYNCH,X'80' SEE IF COMPLETE 00830000 BNO ADAECBCK NOT DONE YET 00831000 OI $PCOMM1+1,OPEN OPEN GATE 00832000 OC PCTECB(1),ENDCSW+4 SET ECB WITH CSW STATUS 00833000 NI PCTECB,X'EF' TURN OFF INUSE 00834000 XC IOSYNCH(4),IOSYNCH CLEAR OUT SYNCH LOCK 00835000 SPACE 1 00836000 ADAECBCK EQU * 00837000 TM ADAECB,X'80' IS THE ADAPTER POSTED 00838000 BNO ALLCHK NO 00839000 OI $COMCOM+5,OPEN OPEN GATE 00840000 B GOLOGIT GO LOG THE RECEIVED BUFFER 00841000 SPACE 00842000 LOGITBK EQU * 00843000 XC ADAECB(4),ADAECB CLEAR ECB 00844000 L R6,SMLLINK GET LINK TABLE ENTRY ADDRESS 00845000 TM LFLAG,LDRAIN IS A DRAIN IN PROGRESS? 00846000 BNO ALLHLD NO CONTINUE 00847000 CLI MASTERSW,X'00' ALL FUNCTIONS COMPLETED? 00848000 BNE ALLHLD NO..CONTINUE @VA03276 00849000 CLC $OUTBUF(4),=F'0' ALL BUFFERS SENT @VA03276 00850000 BE EOJ YES..GO END THE THING @VA03276 00851000 ALLHLD EQU * 00852000 TM RDRCMD,RHLDIPGS IS A HOLD PENDING? 00853000 BNO ALLCHK NO CONTINUE 00854000 CLI MASTERSW,X'00' NOTHING ACTIVE? 00855000 BNE ALLCHK YES..ACTIVE PROCESSOR 00856000 CLC $OUTBUF(4),=F'0' ALL BUFFERS SENT? @VA03276 00857000 BNE ALLCHK NO..CONTINUE ON @VA03276 00858000 OI LFLAG,LHOLD INDICATE WE ARE HELD 00859000 MVC MSGLINK(8),HLDCMDLK SET RESPONSE LINKID 00860000 MSG 611,AXSLINK WRITE HELD MSG 00861000 NI RDRCMD,255-RHLDIPGS TURN OFF COMMAND 00862000 ALLCHK EQU * 00863000 CLC $START($COMEND-$START),$ALLOFF ARE ALL BRANCHES NO-OPD 00864000 BNE $START IF NO GO AROUND AGAIN 00865000 L R15,WAITREQ SYSTEM WAIT PROCESSOR 00866000 LA R1,ECBLIST GET ECBLIST ADDR 00867000 BALR R14,R15 GO WAIT FOR POSTING 00868000 B CMDECK GO FIND WHO WOKE US UP 00869000 DROP R8 00870000 EJECT 00871000 DS 0F 00872000 ECBLIST DC A(RDEVSYNC) SYNCH LOCK LIST 00873000 UACON DC X'40',AL3(0) PUNCH SYNCH LOCK 00874000 JACON DC X'40',AL3(0) JOB PUNCH SYNCH LOCK 00875000 DC A(CMDECB) COMMAND SYNCH LOCK 00876000 DC A(MSGECB) MSGS QUEUED SYNCH LOCK 00877000 PACON DC X'40',AL3(0) PRINT SYNCH LOCK 00878000 DC X'80' INDICATE LAST IN LIST 00879000 DC AL3(ADAECB) ADAPTER SYNCH LOCK 00880000 SPACE 1 00881000 $ALLOFF NOP $CONTROL DUMMY COMMUTATOR 00882000 NOP $TPGET TO COMPARE FOR ALL NO-OPS 00883000 NOP $PCOM1 - 00884000 NOP $RCOM1 - 00885000 NOP $UCOM1 - 00886000 NOP $JCOM1 - 00887000 NOP $WCOM1 - 00888000 NOP CMDPROC - 00889000 NOP MSGPROC - 00890000 NOP $COMSUP - 00891000 NOP $INTRUPT - 00892000 SPACE 1 - 00893000 GOLOGIT EQU * 00894000 STM R14,R1,KRSAV SAVE REGISTERS 00895000 L R14,CBUFFER GET LAST TP BUFFER ADDR 00896000 LA R14,7(R14) START OF DATA 00897000 LA R1,R INDICATE READ 00898000 BAL R15,KLOGIT GO LOG IT 00899000 LM R14,R1,KRSAV RESTORE REGISTERS 00900000 B LOGITBK AND CONTINUE 00901000 SPACE 00902000 KRSAV DC 4F'0' SAVE AREA 00903000 SPACE 3 00904000 OPEN EQU X'F0' GATE OPEN 00905000 CLOSE EQU X'00' GATE CLOSED 00906000 EJECT 00907000 CNOP 6,8 00908000 $CCOM1 BALR R7,0 ENTRY FROM COMMUTATOR TO PROCESSOR 00909000 $TCT1 DS 0H ORIGIN OF TASK CONTROL TABLE 00910000 CTCT DS 0H 00911000 $CTLTCT EQU * 00912000 CCTSTRT B $CRTN1 B TO PROPER PROCESSOR ENTRY 00913000 CCTENTY EQU *-2 ADR PORTION ***MODIFIED BY PROCE 00914000 CCTRTN B $CCOMM1+4 B TO NEXT PROCESSOR VIA COMMUTA 00915000 CCTCCW DC X'0' CCW FOR DEVICE OP-CODE 00916000 CCTDATA DC AL3(0) ADDRESS OF DATA TRANSFERRED 00917000 CCTFLAG DC X'20' FLAGS ON CCW 00918000 CCTOPCOD DC X'00' SAVE AREA FOR CCW OP-CODE 00919000 CCTCCWCT DC AL2(80) CCW COUNT OF DATA TRANSFERRED 00920000 CCTECB DC X'00' EVENT CONTROL 00921000 CCTSTAT DC X'00' STATUS FLAGS 00922000 CCTWFB DC AL1(0) WAITING FOR BUFFERS 00923000 CCTSAV1 DC F'0' SAVE AREA FOR PROCESSOR ROUTINE 00924000 CCTNEXT DC A($TCT2) NEXT TCT IN CHAIN 00925000 CCTFCS DC X'0000' FUNCTION CONTROL SEQUENCE MASK 00926000 CCTRCBR DC X'80' RECV RECORD CONTROL BLOCK 00927000 CCTRCBT DC X'00' TRANS RECORD CONTROL BLOCK 00928000 CCTCOM DC A($CCOMM1) POINTER BACK TO COMMUTATOR 00929000 CDEVSYNC DC F'0' SYNCH LOCK 00930000 CDEVREQN DC CL4'AXS ' FILE ACCESS NAME 00931000 CDEVREQ DC A(*+8) REQUEST BUFFER ADDRESS 00932000 CDEVRESP DC AL1(19),AL3(*+3) RESPONSE BUFFER 00933000 CDEVRLEN DC AL1(0) REQUEST LENGTH 00934000 CDEVFUN DC AL1(0) REQUEST FUNCTION 00935000 CDEVRESV DC AL1(0) RESERVED BYTE 00936000 CDEVSOPT DC AL1(0) SUB OPTION BYTE 00937000 CDEVTAG DC A(0) TAG ADDRESS 00938000 CDEVFIOA DC A(0) FILE I/O AREA 00939000 CDEVLINK DC CL8' ' LINK NAME 00940000 CSW1 DC AL1(0) DEVICE SWITCH 1 00941000 CSW2 DC AL1(0) DEVICE SWITCH 2 00942000 CSW3 DC AL1(0) DEVICE SWITCH 3 00943000 CSW4 DC AL1(0) DEVICE SWITCH 4 00944000 CCTTOVM DC CL8' ' VM OUTPUT DESTINATION 00945000 * 00946000 * NORMAL DEVICE ECTENTION 00947000 * 00948000 CCTTANK DC A(0) NEXT TANK TO OUTPUT 00949000 CCTBUFER DC A(0) ADDR OF CURRENT BUFFER 00950000 * 00951000 * TNKLM,TNKCT AND BUFLM,BUFCT MUST APPEAR IN SEQ AND STRT 00952000 * ON HALF WORD BOUNDARIES 00953000 CCTTNKLM DC AL1(15) MAX NUM OF TANKS ASSIGNABLE TO 00954000 CCTTNKCT DC AL1(0) CURRENT NUM ASSIGNED 00955000 CCTBUFLM DC AL1(5) MAX NUM OF BUFFERS ASSIGNABLE 00956000 CCTBUFCT DC AL1(0) CURRENT NUM ASSIGNED 00957000 EJECT 00958000 CNOP 6,8 00959000 $WCOM1 BALR R7,0 ENTRY FROM COMMUTATOR TO PROCESSOR 00960000 $TCT2 DS 0H ORIGIN OF TASK CONTROL TABLE 00961000 WTCT DS 0H 00962000 $CONTCT EQU * 00963000 WCTSTRT B $WRTN1 B TO PROPER PROCESSOR ENTRY 00964000 WCTENTY EQU *-2 ADR PORTION ***MODIFIED BY PROCE 00965000 WCTRTN B $WCOMM1+4 B TO NEXT PROCESSOR VIA COMMUTA 00966000 WCTCCW DC X'0' CCW FOR DEVICE OP-CODE 00967000 WCTDATA DC AL3(0) ADDRESS OF DATA TRANSFERRED 00968000 WCTFLAG DC X'20' FLAGS ON CCW 00969000 WCTOPCOD DC X'00' SAVE AREA FOR CCW OP-CODE 00970000 WCTCCWCT DC AL2(80) CCW COUNT OF DATA TRANSFERRED 00971000 WCTECB DC X'00' EVENT CONTROL 00972000 WCTSTAT DC X'10' STATUS FLAGS 00973000 WCTWFB DC AL1(0) WAITING FOR BUFFERS 00974000 WCTSAV1 DC F'0' SAVE AREA FOR PROCESSOR ROUTINE 00975000 WCTNEXT DC A($TCT3) NEXT TCT IN CHAIN 00976000 WCTFCS DC X'0040' FUNCTION CONTROL SEQUENCE MASK 00977000 WCTRCBR DC X'91' RECV RECORD CONTROL BLOCK 00978000 WCTRCBT DC X'00' TRANS RECORD CONTROL BLOCK 00979000 WCTCOM DC A($WCOMM1) POINTER BACK TO COMMUTATOR 00980000 WDEVSYNC DC F'0' SYNCH LOCK 00981000 WDEVREQN DC CL4'AXS ' FILE ACCESS NAME 00982000 WDEVREQ DC A(*+8) REQUEST BUFFER ADDRESS 00983000 WDEVRESP DC AL1(19),AL3(*+3) RESPONSE BUFFER 00984000 WDEVRLEN DC AL1(0) REQUEST LENGTH 00985000 WDEVFUN DC AL1(0) REQUEST FUNCTION 00986000 WDEVRESV DC AL1(0) RESERVED BYTE 00987000 WDEVSOPT DC AL1(0) SUB OPTION BYTE 00988000 WDEVTAG DC A(0) TAG ADDRESS 00989000 WDEVFIOA DC A(0) FILE I/O AREA 00990000 WDEVLINK DC CL8' ' LINK NAME 00991000 WSW1 DC AL1(0) DEVICE SWITCH 1 00992000 WSW2 DC AL1(0) DEVICE SWITCH 2 00993000 WSW3 DC AL1(0) DEVICE SWITCH 3 00994000 WSW4 DC AL1(0) DEVICE SWITCH 4 00995000 WCTTOVM DC CL8' ' VM OUTPUT DESTINATION 00996000 * 00997000 * NORMAL DEVICE EWTENTION 00998000 * 00999000 WCTTANK DC A(0) NEXT TANK TO OUTPUT 01000000 WCTBUFER DC A(0) ADDR OF CURRENT BUFFER 01001000 * 01002000 * TNKLM,TNKCT AND BUFLM,BUFCT MUST APPEAR IN SEQ AND STRT 01003000 * ON HALF WORD BOUNDARIES 01004000 WCTTNKLM DC AL1(13) MAX NUM OF TANKS ASSIGNABLE TO 01005000 WCTTNKCT DC AL1(0) CURRENT NUM ASSIGNED 01006000 WCTBUFLM DC AL1(3) MAX NUM OF BUFFERS ASSIGNABLE 01007000 WCTBUFCT DC AL1(0) CURRENT NUM ASSIGNED 01008000 EJECT 01009000 * 01010000 * TANK EXTENTIONS FOR READER AND CONSOLE PROCESSORS 01011000 * 01012000 WCTTANK1 DC A(0) TANKCHN AND WORK AREA ONE 01013000 WCTTRCB1 DC X'92' RCB IDENTIFICATION 01014000 WCTTSRC1 DC X'80' SRCB IDENTIFICATION 01015000 WCTTCT1 DC H'80' NUMBER OF DATA CHARACTERS 01016000 WCTTDTA1 DC CL124' ' 01017000 DC CL4' ' ALLOW ROOM FOR MSG OF 120+LOCID @VA03279 01018000 EJECT 01019000 CNOP 6,8 01020000 $PCOM1 BALR R7,0 ENTRY FROM COMMUTATOR TO PROCESSOR 01021000 $TCT3 DS 0H ORIGIN OF TASK CONTROL TABLE 01022000 PTCT DS 0H 01023000 PCTSTRT B $PRTN1 B TO PROPER PROCESSOR ENTRY 01024000 PCTENTY EQU *-2 ADR PORTION ***MODIFIED BY PROCE 01025000 PCTRTN B $PCOMM1+4 B TO NEXT PROCESSOR VIA COMMUTA 01026000 PCTCCW DC X'0' CCW FOR DEVICE OP-CODE 01027000 PCTDATA DC AL3(0) ADDRESS OF DATA TRANSFERRED 01028000 PCTFLAG DC X'20' FLAGS ON CCW 01029000 PCTOPCOD DC X'01' SAVE AREA FOR CCW OP-CODE 01030000 PCTCCWCT DC AL2(80) CCW COUNT OF DATA TRANSFERRED 01031000 PCTECB DC X'00' EVENT CONTROL 01032000 PCTSTAT DC X'08' STATUS FLAGS 01033000 PCTWFB DC AL1(0) WAITING FOR BUFFERS 01034000 PCTSAV1 DC F'0' SAVE AREA FOR PROCESSOR ROUTINE 01035000 PCTNEXT DC A($TCT4) NEXT TCT IN CHAIN 01036000 PCTFCS DC X'0800' FUNCTION CONTROL SEQUENCE MASK 01037000 PCTRCBR DC X'94' RECV RECORD CONTROL BLOCK 01038000 PCTRCBT DC X'00' TRANS RECORD CONTROL BLOCK 01039000 PCTCOM DC A($PCOMM1) POINTER BACK TO COMMUTATOR 01040000 PDEVSYNC DC F'0' SYNCH LOCK 01041000 PDEVREQN DC CL4'AXS ' FILE ACCESS NAME 01042000 PDEVREQ DC A(*+8) REQUEST BUFFER ADDRESS 01043000 PDEVRESP DC AL1(19),AL3(*+3) RESPONSE BUFFER 01044000 PDEVRLEN DC AL1(19) REQUEST LENGTH 01045000 PDEVFUN DC AL1(0) REQUEST FUNCTION 01046000 PDEVRESV DC AL1(0) RESERVED BYTE 01047000 PDEVSOPT DC AL1(0) SUB OPTION BYTE 01048000 PDEVTAG DC A(PTAG) TAG ADDRESS 01049000 PDEVFIOA DC A(0) FILE I/O AREA 01050000 PDEVLINK DC CL8' ' LINK NAME 01051000 PSW1 DC AL1(0) DEVICE SWITCH 1 01052000 PSW2 DC AL1(0) DEVICE SWITCH 2 01053000 PSW3 DC AL1(0) DEVICE SWITCH 3 01054000 PSW4 DC AL1(0) DEVICE SWITCH 4 01055000 PCTTOVM DC CL8' ' VM OUTPUT DESTINATION 01056000 * 01057000 * NORMAL DEVICE EPTENTION 01058000 * 01059000 PCTTANK DC A(0) NEXT TANK TO OUTPUT 01060000 PCTBUFER DC A(0) ADDR OF CURRENT BUFFER 01061000 * 01062000 * TNKLM,TNKCT AND BUFLM,BUFCT MUST APPEAR IN SEQ AND STRT 01063000 * ON HALF WORD BOUNDARIES 01064000 PCTTNKLM DC AL1(1) MAX NUM OF TANKS ASSIGNABLE TO 01065000 PCTTNKCT DC AL1(0) CURRENT NUM ASSIGNED 01066000 PCTBUFLM DC AL1(2) MAX NUM OF BUFFERS ASSIGNABLE 01067000 PCTBUFCT DC AL1(0) CURRENT NUM ASSIGNED 01068000 PTAG DC 108CL1' ' DEVICE TAG 01069000 EJECT 01070000 CNOP 6,8 01071000 $RCOM1 BALR R7,0 ENTRY FROM COMMUTATOR TO PROCESSOR 01072000 $TCT4 DS 0H ORIGIN OF TASK CONTROL TABLE 01073000 RTCT DS 0H 01074000 RCTSTRT B $RRTN1 B TO PROPER PROCESSOR ENTRY 01075000 RCTENTY EQU *-2 ADR PORTION ***MODIFIED BY PROCE 01076000 RCTRTN B $RCOMM1+4 B TO NEXT PROCESSOR VIA COMMUTA 01077000 RCTCCW DC X'0' CCW FOR DEVICE OP-CODE 01078000 RCTDATA DC AL3(0) ADDRESS OF DATA TRANSFERRED 01079000 RCTFLAG DC X'20' FLAGS ON CCW 01080000 RCTOPCOD DC X'00' SAVE AREA FOR CCW OP-CODE 01081000 RCTCCWCT DC AL2(80) CCW COUNT OF DATA TRANSFERRED 01082000 RCTECB DC X'00' EVENT CONTROL 01083000 RCTSTAT DC X'00' STATUS FLAGS 01084000 RCTWFB DC AL1(0) WAITING FOR BUFFERS 01085000 RCTSAV1 DC F'0' SAVE AREA FOR PROCESSOR ROUTINE 01086000 RCTNEXT DC A($TCT5) NEXT TCT IN CHAIN 01087000 RCTFCS DC X'0800' FUNCTION CONTROL SEQUENCE MASK 01088000 RCTRCBR DC X'FF' RECV RECORD CONTROL BLOCK 01089000 RCTRCBT DC X'93' TRANS RECORD CONTROL BLOCK 01090000 RCTCOM DC A($RCOMM1) POINTER BACK TO COMMUTATOR 01091000 RDEVSYNC DC F'0' SYNCH LOCK 01092000 RDEVREQN DC CL4'AXS ' FILE ACCESS NAME 01093000 RDEVREQ DC A(*+8) REQUEST BUFFER ADDRESS 01094000 RDEVRESP DC AL1(19),AL3(*+3) RESPONSE BUFFER 01095000 RDEVRLEN DC AL1(0) REQUEST LENGTH 01096000 RDEVFUN DC AL1(0) REQUEST FUNCTION 01097000 RDEVRESV DC AL1(0) RESERVED BYTE 01098000 RDEVSOPT DC AL1(0) SUB OPTION BYTE 01099000 RDEVTAG DC A(0) TAG ADDRESS 01100000 RDEVFIOA DC A(0) FILE I/O AREA 01101000 RDEVLINK DC CL8' ' LINK NAME 01102000 RSW1 DC AL1(0) DEVICE SWITCH 1 01103000 RSW2 DC AL1(0) DEVICE SWITCH 2 01104000 RSW3 DC AL1(0) DEVICE SWITCH 3 01105000 RSW4 DC AL1(0) DEVICE SWITCH 4 01106000 RCTTOVM DC CL8' ' VM OUTPUT DESTINATION 01107000 * 01108000 * TANK ERTENTIONS FOR READER AND CONSOLE PROCESSORS 01109000 * 01110000 RCTTANK1 DC A(0) TANKCHN AND WORK AREA ONE 01111000 RCTTRCB1 DC X'93' RCB IDENTIFICATION 01112000 RCTTSRC1 DC X'80' SRCB IDENTIFICATION 01113000 RCTTCT1 DC H'80' NUMBER OF DATA CHARACTERS 01114000 RCTTDTA1 DC CL136' ' 01115000 EJECT 01116000 CNOP 6,8 01117000 $UCOM1 BALR R7,0 ENTRY FROM COMMUTATOR TO PROCESSOR 01118000 $TCT5 DS 0H ORIGIN OF TASK CONTROL TABLE 01119000 UTCT DS 0H 01120000 UCTSTRT B $URTN1 B TO PROPER PROCESSOR ENTRY 01121000 UCTENTY EQU *-2 ADR PORTION ***MODIFIED BY PROCE 01122000 UCTRTN B $UCOMM1+4 B TO NEXT PROCESSOR VIA COMMUTA 01123000 UCTCCW DC X'0' CCW FOR DEVICE OP-CODE 01124000 UCTDATA DC AL3(0) ADDRESS OF DATA TRANSFERRED 01125000 UCTFLAG DC X'20' FLAGS ON CCW 01126000 UCTOPCOD DC X'41' SAVE AREA FOR CCW OP-CODE 01127000 UCTCCWCT DC AL2(80) CCW COUNT OF DATA TRANSFERRED 01128000 UCTECB DC X'00' EVENT CONTROL 01129000 UCTSTAT DC X'00' STATUS FLAGS 01130000 UCTWFB DC AL1(0) WAITING FOR BUFFERS 01131000 UCTSAV1 DC F'0' SAVE AREA FOR PROCESSOR ROUTINE 01132000 UCTNEXT DC A($TCT6) NEXT TCT IN CHAIN 01133000 UCTFCS DC X'0001' FUNCTION CONTROL SEQUENCE MASK 01134000 UCTRCBR DC X'95' RECV RECORD CONTROL BLOCK 01135000 UCTRCBT DC X'00' TRANS RECORD CONTROL BLOCK 01136000 UCTCOM DC A($UCOMM1) POINTER BACK TO COMMUTATOR 01137000 UDEVSYNC DC F'0' SYNCH LOCK 01138000 UDEVREQN DC CL4'AXS ' FILE ACCESS NAME 01139000 UDEVREQ DC A(*+8) REQUEST BUFFER ADDRESS 01140000 UDEVRESP DC AL1(19),AL3(*+3) RESPONSE BUFFER 01141000 UDEVRLEN DC AL1(19) REQUEST LENGTH 01142000 UDEVFUN DC AL1(0) REQUEST FUNCTION 01143000 UDEVRESV DC AL1(0) RESERVED BYTE 01144000 UDEVSOPT DC AL1(0) SUB OPTION BYTE 01145000 UDEVTAG DC A(UTAG) TAG ADDRESS 01146000 UDEVFIOA DC A(0) FILE I/O AREA 01147000 UDEVLINK DC CL8' ' LINK NAME 01148000 USW1 DC AL1(0) DEVICE SWITCH 1 01149000 USW2 DC AL1(0) DEVICE SWITCH 2 01150000 USW3 DC AL1(0) DEVICE SWITCH 3 01151000 USW4 DC AL1(0) DEVICE SWITCH 4 01152000 UCTTOVM DC CL8' ' VM OUTPUT DESTINATION 01153000 * 01154000 * NORMAL DEVICE EUTENTION 01155000 * 01156000 UCTTANK DC A(0) NEXT TANK TO OUTPUT 01157000 UCTBUFER DC A(0) ADDR OF CURRENT BUFFER 01158000 * 01159000 * TNKLM,TNKCT AND BUFLM,BUFCT MUST APPEAR IN SEQ AND STRT 01160000 * ON HALF WORD BOUNDARIES 01161000 UCTTNKLM DC AL1(1) MAX NUM OF TANKS ASSIGNABLE TO 01162000 UCTTNKCT DC AL1(0) CURRENT NUM ASSIGNED 01163000 UCTBUFLM DC AL1(2) MAU NUM OF BUFFERS ASSIGNABLE 01164000 UCTBUFCT DC AL1(0) CURRENT NUM ASSIGNED 01165000 UTAG DC 108CL1' ' DEVICE TAG 01166000 EJECT 01167000 CNOP 6,8 01168000 $JCOM1 BALR R7,0 ENTRY FROM COMMUTATOR TO PROCESSOR 01169000 $TCT6 DS 0H ORIGIN OF TASK CONTROL TABLE 01170000 JTCT DS 0H 01171000 JCTSTRT B $JRTN1 B TO PROPER PROCESSOR ENTRY 01172000 JCTENTY EQU *-2 ADR PORTION ***MODIFIED BY PROCE 01173000 JCTRTN B $JCOMM1+4 B TO NEXT PROCESSOR VIA COMMUTA 01174000 JCTCCW DC X'0' CCW FOR DEVICE OP-CODE 01175000 JCTDATA DC AL3(0) ADDRESS OF DATA TRANSFERRED 01176000 JCTFLAG DC X'20' FLAGS ON CCW 01177000 JCTOPCOD DC X'41' SAVE AREA FOR CCW OP-CODE 01178000 JCTCCWCT DC AL2(80) CCW COUNT OF DATA TRANSFERRED 01179000 JCTECB DC X'00' EVENT CONTROL 01180000 JCTSTAT DC X'00' STATUS FLAGS 01181000 JCTWFB DC AL1(0) WAITING FOR BUFFERS 01182000 JCTSAV1 DC F'0' SAVE AREA FOR PROCESSOR ROUTINE 01183000 JCTNEXT DC A(0) NEXT TCT IN CHAIN 01184000 JCTFCS DC X'0800' FUNCTION CONTROL SEQUENCE MASK 01185000 JCTRCBR DC X'93' RECV RECORD CONTROL BLOCK 01186000 JCTRCBT DC X'00' TRANS RECORD CONTROL BLOCK 01187000 JCTCOM DC A($JCOMM1) POINTER BACK TO COMMUTATOR 01188000 JDEVSYNC DC F'0' SYNCH LOCK 01189000 JDEVREQN DC CL4'AXS ' FILE ACCESS NAME 01190000 JDEVREQ DC A(*+8) REQUEST BUFFER ADDRESS 01191000 JDEVRESP DC AL1(19),AL3(*+3) RESPONSE BUFFER 01192000 JDEVRLEN DC AL1(19) REQUEST LENGTH 01193000 JDEVFUN DC AL1(0) REQUEST FUNCTION 01194000 JDEVRESV DC AL1(0) RESERVED BYTE 01195000 JDEVSOPT DC AL1(0) SUB OPTION BYTE 01196000 JDEVTAG DC A(JTAG) TAG ADDRESS 01197000 JDEVFIOA DC A(0) FILE I/O AREA 01198000 JDEVLINK DC CL8' ' LINK NAME 01199000 JSW1 DC AL1(0) DEVICE SWITCH 1 01200000 JSW2 DC AL1(0) DEVICE SWITCH 2 01201000 JSW3 DC AL1(0) DEVICE SWITCH 3 01202000 JSW4 DC AL1(0) DEVICE SWITCH 4 01203000 JCTTOVM DC CL8' ' VM OUTPUT DESTINATION 01204000 * 01205000 * NORMAL DEVICE EXTENTION 01206000 * 01207000 JCTTANK DC A(0) NEXT TANK TO OUTPUT 01208000 JCTBUFER DC A(0) ADDR OF CURRENT BUFFER 01209000 * 01210000 * TNKLM,TNKCT AND BUFLM,BUFCT MUST APPEAR IN SEQ AND STRT 01211000 * ON HALF WORD BOUNDARIES 01212000 JCTTNKLM DC AL1(2) MAX NUM OF TANKS ASSIGNABLE TO @VA04612 01213000 JCTTNKCT DC AL1(0) CURRENT NUM ASSIGNED 01214000 JCTBUFLM DC AL1(2) MAX NUM OF BUFFERS ASSIGNABLE 01215000 JCTBUFCT DC AL1(0) CURRENT NUM ASSIGNED 01216000 JTAG DC 108CL1' ' DEVICE TAG 01217000 EJECT 01218000 * 01219000 * BEGINNING OF QUEUE CHAINS 01220000 * 01221000 $TEMP DC H'0' GLOBAL TEMPORARY WORK 01222000 $CHNTEMP DC A(0) DISABLED TEMPORARY WORK 01223000 $BUFPOOL DC A(0) BUFFER POOL CHAIN CONTROL WORD 01224000 $TANKPOL DC A(0) TANK QUEUE CONTROL WORD 01225000 $INBUF DC A(0) RECEIVED BUFFER CHAIN CTL WORD 01226000 $OUTBUF DC A(0) XMISSION BUFFER CHAIN CTL WORD 01227000 $FCSOUT DS 0H OUTGOING FUNCTION CONTROL SEQUENCE 01228000 DC X'8FCF' ALL FUNCTIONS PERMITTED 01229000 $FCSIN DC X'8FCF' INCOMING FCS 01230000 EJECT 01231000 *. 01232000 * 01233000 * ENTRY NAME - 01234000 * 01235000 * $CRTN1 01236000 * 01237000 * FUNCTION - 01238000 * 01239000 * THIS ROUTINE DEQUEUES TANKS FROM ITS TANK QUEUE AND 01240000 * PERFORMS THE ACTION REQUESTED IN BY THE CONTROL RECORD 01241000 * IN THE DEQUEUED TANK. 01242000 * 01243000 * CALLS TO OTHER ROUTINES - 01244000 * 01245000 * NONE 01246000 * 01247000 * OPERATION - 01248000 * 01249000 * 1. TRY TO GET ANOTHER CONTROL TANK. 01250000 * 01251000 * 2. IF ONE IS OBTAINED, EXAMINE THE SRCB TO DETERMINE ITS TYPE. 01252000 * 01253000 * 3. BRANCH TO THE APPROPRIATE ROUTINE TO PROCESS 01254000 * EACH TYPE OF CONTROL RECORD. 01255000 * 01256000 * 4. FREE THE TANK AND EXIT THROUGH THE COMMUTATOR. 01257000 * 01258000 * RESPONSES - 01259000 * 01260000 * NONE 01261000 * 01262000 * ERROR MESSAGES - 01263000 * 01264000 * DMTSML902E NON-SOGNON CARD READ ON LINK (LINKID) 01265000 * DMTSML903E PASSWORD=(PASSWORD) ON LINK (LINKID) IS INVALID 01266000 * 01267000 *. 01268000 EJECT 01269000 * 01270000 * 01271000 $CRTN1 DS 0H 01272000 * 01273000 $CONTROL DS 0H ENTRY POINT 01274000 LA R13,$CTLTCT GET CONTROL TCT 01275000 USING TCTDSECT,R13 * 01276000 SPACE 1 01277000 CLC TCTTANK,=F'0' ARE WE EMPTY 01278000 BE MNONE YES 01279000 L R8,TCTTANK GET FIRST BUFFER ADDRESS 01280000 MVC TCTTANK(4),0(R8) REMOVE THIS ONE FROM CHAIN 01281000 B MPROCESS BR IF GOTTEN 01282000 SPACE 1 01283000 MNONE EQU * 01284000 MVI $CCOMM1+1,CLOSE NONE... CLOSE ENTRY 01285000 B CCTRTN AND EXIT 01286000 EJECT 01287000 *---------------------------------------------------------------------* 01288000 * * 01289000 * PROCESS A CONTROL RECORD * 01290000 * * 01291000 *---------------------------------------------------------------------* 01292000 SPACE 3 01293000 MPROCESS DS 0H * 01294000 LH R5,TCTTNKLM REDUCES COUNT IN TNKCT 01295000 BCTR R5,0 DOWN BY ONE 01296000 STH R5,TCTTNKLM AND REPLACE COUNT 01297000 OI TCTSTAT,TCTACT SIGNAL WE HAVE RECEIVED TANK 01298000 MVI $TPGETCM+1,OPEN OPEN THE GATE TO TPGET ROUTINE 01299000 DROP R13 DONE FOR NOW 01300000 USING TANKDSEC,R8 * 01301000 UNPK MTEMP+1(1),TANKRCB(1) SWAP DIGITS 01302000 NI MTEMP+1,7 TURN OFF CTL BIT 01303000 LH R5,MTEMP GET CTL FUNCTION TYPE 01304000 SLL R5,2 MULT BY 4 01305000 LA R6,MCONTTAB-4 START OF CTL TYPE TABLE 01306000 AR R6,R5 R6 = CORRECT TABLE ENTRY 01307000 L R6,0(0,R6) R6 = CONTROL ADDRESS 01308000 BR R6 ENTER ROUTINE 01309000 EJECT 01310000 *---------------------------------------------------------------------* 01311000 * * 01312000 * SUBROUTINE TO FIND TCT CORRESPONDING TO SRCB FUNCTION * 01313000 * R14=RETURN , CC NE 0 -R13 CONTAINS TCT,CC=0-NOT FOUND* 01314000 *---------------------------------------------------------------------* 01315000 SPACE 3 01316000 MTCTFIND DS 0H ENTRY POINT 01317000 LA R13,$TCT1 FIRST TCT 01318000 USING TCTDSECT,R13 ADDRESSABILITY 01319000 MNEXTTCT DS 0H * 01320000 CLC TCTRCBR,TANKSRCB IS THIS CORRECT TCT 01321000 BE MTCTOK BR IF YES 01322000 ICM R13,B'1111',TCTNEXT NO..TO NEXT AND CHECK FOR LAST 01323000 BNZ MNEXTTCT BR IF MORE 01324000 BR R14 RETURN WITH COND. CODE = 0 01325000 SPACE 1 01326000 MTCTFNDT DS 0H ENTRY POINT 01327000 LA R13,$TCT1 FIRST TCT 01328000 USING TCTDSECT,R13 ADDRESSABILITY 01329000 MNXTTCTT DS 0H * 01330000 CLC TCTRCBT,TANKSRCB IS THIS CORRECT TCT 01331000 BE MTCTOK BR IF YES 01332000 ICM R13,B'1111',TCTNEXT NO..TO NEXT AND CHECK FOR LAST 01333000 BNZ MNXTTCTT BR IF MORE 01334000 BR R14 RETURN WITH COND. CODE = 0 01335000 SPACE 1 01336000 MTCTOK EQU * 01337000 LTR R14,R14 SET COND. CODE NON-ZERO 01338000 BR R14 AND RETURN 01339000 EJECT 01340000 SPACE 5 01341000 *---------------------------------------------------------------------* 01342000 * * 01343000 * SUBROUTINE TO $TPPUT AN ANSWERING CTL RECORD * 01344000 * R8 = TANKADDR * 01345000 * * 01346000 *---------------------------------------------------------------------* 01347000 SPACE 3 01348000 MPUT DS 0H ENTRY POINT 01349000 BAL R14,$TPPUT GO PUT RECORD 01350000 BNZ MEXIT EXIT IF ACCEPTED 01351000 MVC $CCOMM1+2(2),MREPUTA SET COMUTATOR RE-ENTRY 01352000 ST R8,MTANK SAVE TANK ADDR 01353000 B CCTRTN EXIT TO COMUTATOR 01354000 SPACE 1 01355000 MREPUT DS 0H RETRY PUTTING RECORD 01356000 L R8,MTANK RESTORE TANK ADDR 01357000 BAL R14,$TPREPUT TRY IT 01358000 BZ $CCOMM1+4 CYCLE IF STILL NOT ACCEPTED 01359000 SPACE 1 01360000 MEXIT DS 0H ENTRY AT END OF PROCESSING 01361000 MVC 0(4,R8),$TANKPOL GET FIRST FREE OFF QUEUE 01362000 ST R8,$TANKPOL MAKE THIS ONE THE FIRST 01363000 MVI $TPGETCM+1,OPEN OPEN TPGET GATE 01364000 MVC $CCOMM1+2(2),MCONTROL RESET COMUTATOR 01365000 B $CONTROL AND TRY NEXT TANK 01366000 SPACE 2 01367000 MTANK DC A(0) TANK REG STORAGE 01368000 MTEMP DC H'0' TEMP STORAGE (HI-BYTE ALWAYS ZERO) 01369000 MREPUTA DC S(MREPUT) COMMUTATOR ADJUSTMENT ADDR 01370000 MCONTROL DC S($CONTROL) COMMUTATOR ADJUSTMENT ADDR 01371000 MCONTTAB DS 0F CONTROL TYPE BRANCH TABLE 01372000 * DC A(MC0) 000 RESERVED 01373000 DC A(MC1) 001 START FUNCTION REQUEST 01374000 DC A(MC2) 010 START FUNCTION PERMISSION 01375000 DC A(MC3) 011 RESERVED 01376000 DC A(MC4) 100 RESERVED 01377000 DC A(MC5) 101 RESERVED 01378000 DC A(MC6) 110 RESERVED 01379000 DC A(MC7) 111 GENERAL CONTROL TYPE 01380000 EJECT 01381000 SPACE 3 01382000 * 01383000 * MC0 CONTROL RECORD , TYPE = 000 (RESERVED) 01384000 * 01385000 SPACE 3 01386000 * 01387000 * RESERVED FOR FUTURE USE 01388000 * 01389000 MC0 EQU MEXIT TO DEFINE SYMBOL 01390000 SPACE 3 01391000 * 01392000 * MC1 CONTROL RECORD , TYPE = 001(REQUEST TO START FUNCTION) 01393000 * 01394000 SPACE 3 01395000 MC1 DS 0H * 01396000 * 01397000 BAL R14,MTCTFIND GO FIND TCT 01398000 BZ MEXIT IGNORE REQUEST IF NOT FOUND 01399000 TM SMLSYS,MASTER MASTER MODE? 01400000 BNO MTCTSET NO CONTINUE 01401000 TM SMLSYS,SGNONREC HAVE WE RECEIVED SIGNON CARD? 01402000 BNO MEXIT NO...NOTHING TILL THEN 01403000 SPACE 1 01404000 MTCTSET DS 0H CORRECT TCT FOUND 01405000 TM TCTSTAT,TCTOPEN CAN DEVICE BE STARTED 01406000 NI TCTSTAT,255-TCTOPEN SHOW USE 01407000 OC $FCSOUT,TCTFCS ALLOW BUFFERS 01408000 MVZ TANKRCB,=X'A0' CHANGE REQUEST TO PERMISSION 01409000 B MPUT AND SEND IT 01410000 SPACE 3 01411000 * 01412000 * MC2 CONTROL RECORD , TYPE = 010(PERMISSION TO START FCN) 01413000 * 01414000 SPACE 3 01415000 MC2 DS 0H ENTRY POINT 01416000 BAL R14,MTCTFNDT GO LOOK-UP TCT 01417000 BZ MEXIT IGNORE IF NOT FOUND 01418000 L R14,TCTCOM GET COMUTATOR ENTRY 01419000 MVI 1(R14),OPEN OPEN IT 01420000 NI TCTSTAT,255-TCTOPEN SHOW OPEN 01421000 B MEXIT AND EXIT 01422000 EJECT 01423000 * 01424000 * MC3 CONTROL RECORD , TYPE = 011 (RESERVED) 01425000 SPACE 3 01426000 MC3 EQU MEXIT NOT YET DEFINED 01427000 SPACE 3 01428000 * 01429000 * MC4 CONTROL RECORD , TYP = 100 (RESERVED) 01430000 * 01431000 SPACE 3 01432000 MC4 EQU MEXIT NOT YET DEFINED 01433000 SPACE 3 01434000 * 01435000 * MC5 CONTROL RECORD , TYPE = 101 (RESERVED) 01436000 * 01437000 SPACE 3 01438000 MC5 EQU MEXIT TO DEFINE SYMBOL 01439000 * FUNCTION IS NOT YET SUPPORTED 01440000 SPACE 3 01441000 * 01442000 * MC6 CONTROL RECORD , TYPE = 110(RESERVED) 01443000 * 01444000 SPACE 3 01445000 * 01446000 * THIS CONTROL TYPE IS CURRENTLY UNDEFINED BUT IS 01447000 * RESERVED FOR FUTURE USE. 01448000 * 01449000 MC6 EQU MEXIT TO DEFINE SYMBOL 01450000 EJECT 01451000 * 01452000 * MC7 CONTROL RECORD , TYPE = 111 (GENERALIZED CONTROL) 01453000 * (TYPE INDICATED IN SRCB) 01454000 * 01455000 SPACE 3 01456000 MC7 EQU * ENTRY POINT 01457000 CLI TANKSRCB,C'A' IS IT A SIGNON RECORD? 01458000 BNE MEXIT NO IGNORE IT 01459000 CLC TANKDATA(9),ICTXT IS IT A SIGNON CARD? @VA03347 01460000 BE MC7A YES CONTINUE 01461000 MC7ERR EQU * 01462000 MSG 902,AXSLINK WRITE INVALID SIGNON MSG 01463000 B EOJ ALL DONE 01464000 SPACE 01465000 MC7A EQU * 01466000 CLC TANKDATA+21(2),MRN CORRECT REMOTE NUMBER? @VA03347 01467000 BNE MC7ERR NO WRITE MSG AND QUIT 01468000 CLI PASSWORD,C' ' WAS A PASSWD SPECIFIED? 01469000 BE MC7B NO..NO CHECK NECESSARY 01470000 CLC TANKDATA+24(8),PASSWORD DOES HE HAVE THE CORRECT PASSWD? 01471000 BE MC7B YES ALL OKAY 01472000 MSG 903,AXSLINK WRITE MSG AND QUIT @VA03421 01473000 B EOJ AND GO TO END 01474000 EJECT 01475000 MC7B EQU * 01476000 MSG 905,AXSLINK INDICATE SIGNON COMPLETE 01477000 OI SMLSYS,SGNONREC INDICATE SIGNON ACCEPTED 01478000 B MEXIT AND RETURN 01479000 * 01480000 * CURRENTLY NO OTHER FUNCTIONS ARE IMPLEMENTED FOR THIS 01481000 * CONTROL FUNCTION. THE TYPE OF CONTROL RECORD, SUCH 01482000 * AS ACCOUNTING,SIGN-ON,INITIALIZATION,ETC, IS 01483000 * INDICATED IN THE SRCB. 01484000 * THE SRCB IDENTIFICATION CHARACTERS 'A' THRU 'R' 01485000 * AND '0' THRU '9' ARE RESERVED FOR FUTURE RSCS 01486000 * DEVELOPMENT. ALL OTHER EBCDIC CHARACTERS , WHICH 01487000 * ARE TRANSMISSION COMPATIBLE ARE AVAILABLE TO THE 01488000 * USER TO ADD ADDITIONAL CONTROL FUNCTIONS. 01489000 * 01490000 SPACE 3 01491000 DROP R8,R13 01492000 EJECT 01493000 *. 01494000 * 01495000 * ENTRY NAME - 01496000 * 01497000 * $PRTN1 01498000 * 01499000 * FUNCTION - 01500000 * 01501000 * THIS ROUTINE DEQUEUES TANKS FROM ITS TANK QUEUE, OBTAINS 01502000 * A NEW OUTPUT SPOOL DEVICE IF NEEDED FROM DMTAXS, AND 01503000 * OUTPUTS THE TANK TO A VIRTUAL PRINTER. 01504000 * 01505000 * CALLS TO OTHER ROUTINES - 01506000 * 01507000 * DMTIOMRQ - TO INITIATE AN I/O OPERATION 01508000 * 01509000 * OPERATION - 01510000 * 01511000 * 1. OBTAIN A TANK FROM $GETTNK 01512000 * 01513000 * 2. IF OBTAINED CHECK TO SEE IF OUTPUT FILE IS OPENED, 01514000 * IF NOT OBTAIN A OUTPUT DEVICE BY A CALL TO AXS. 01515000 * 01516000 * 3. CONTRUCT THE CARRIAGE CONTROL FROM THE INFORMATION 01517000 * CONTAINED IN THE SRCB. 01518000 * 01519000 * 4. WRITE THE RECORD TO THE VM/370 SPOOL FILE SYSTEM. 01520000 * 01521000 * 5. WHEN EOF IS OBTAINED CLOSE THE FILE VIA ANOTHER CALL 01522000 * TO AXS. 01523000 * 01524000 * 6. EXIT TO COMMUTATOR 01525000 * 01526000 * RESPONSES - 01527000 * 01528000 * DMTSML144I RECEIVING: FILE FROM 'LOCID1' ('USERID1') FOR 01529000 * 'LOCID2' ('USERID2') 01530000 * DMTSML145I RECEIVED: FILE FROM 'LOCID1' ('USERID1') FOR 01531000 * 'LOCID2' ('USERID2') 01532000 * 01533000 * ERROR MESSAGES - 01534000 * 01535000 * NONE 01536000 * 01537000 *. 01538000 SPACE 1 01539000 USING TANKDSEC,R8 GET TANK ADDRESSABILITY 01540000 USING IOTABLE,R1 GET IOTABLE ADDRESSABILITY 01541000 $PRTN1 DS 0H 01542000 PNEXT EQU * BASIC LOOP 01543000 BAL R14,$GETTNK WAIT FOR THE NEXT TANK 01544000 CLI TANKCNT+1,0 TEST FOR END OF JOB 01545000 BNE PCONT NO CONTINUE 01546000 PCLOSE EQU * 01547000 LA R1,PDEVSYNC GET PRINTER DEVICE BLOCK 01548000 LA R0,X'12' INDICATE CLOSE FUNCTION 01549000 BAL R14,AXS GO CLOSE THE FILE 01550000 NI MASTERSW,255-PRINTER RESET OPEN FLAG 01551000 OI PACON,ECBSKIP INDICATE SKIP ECB 01552000 MSG 145,(AXSLINK,SYSTYPE,LOCATION,BLANK) WRITE CLOSE@VM01105 01553000 B PFREE FREE THE TANK IF END OF JOB 01554000 SPACE 1 01555000 PCONT EQU * 01556000 TM MASTERSW,PRINTER SEE IF FILE IS ACTIVE 01557000 BO PCONT2 OPEN..OKAY CONTINUE 01558000 LA R1,PDEVSYNC GET PRINTER DEVICE BLOCK 01559000 LA R0,X'11' INDICATE GET SPOOL DEVICE 01560000 BAL R14,AXS GO INTERFACE TO FILE ACCESS 01561000 L R1,PDEVFIOA GET FILE I/O AREA ADDRESS 01562000 ST R1,PACON AND STORE IN ECB LIST 01563000 XC 0(4,R1),0(R1) INITIALLY CLEAR SYNCH LOCK 01564000 OI MASTERSW,PRINTER INDICATE FILE ACTIVE 01565000 MSG 144,(AXSLINK,SYSTYPE,LOCATION,BLANK) WRITE RECV @VM01105 01566000 PCONT2 EQU * 01567000 CLI TANKSRCB,X'8E' LOOK FOR CHANGE IN FORMS 01568000 BE PFREE IGNORE THIS LINE IF FORMS MSG 01569000 MVC PCTCCWCT+1(1),TANKCNT+1 MOVE COUNT TO CCW 01570000 EJECT 01571000 * 01572000 * SET UP CARRIAGE CONTROL 01573000 * 01574000 LA R6,TANKDATA GET TANK ADDRESS 01575000 ST R6,PCTCCW STORE IN CCW 01576000 IC R6,TANKSRCB PICK UP CARRIAGE CONTROL INFO 01577000 SLL R6,3 ALIGN CC BITS FOR OPCODE 01578000 STC R6,PCTOPCOD STORE IN CCW 01579000 TM TANKSRCB,PSKIMM TEST FOR SKIP IMMEDIATE 01580000 BZ KNOTIMM IF NOT AN IMMEDIATE SPACE, GO 01581000 OI PCTOPCOD,PCCOP MOVE IMMEDIATE PRINT CODE IN 01582000 MVI PCTECB,X'10' SHOW PRINT BUSY 01583000 L R1,PDEVFIOA GET FILE I/O AREA ADDRESS 01584000 LA R6,PCTCCW GET CCW ADDRESS 01585000 ST R6,PROGADDR SET CAW IN DEVICE BLOCK 01586000 OC PCTCCW(1),PCTOPCOD SET OPCODE IN CCW 01587000 L R15,IOREQ SYSTEM I/O PROCESSOR 01588000 BALR R14,R15 GO EXECUTE THE I/O 01589000 BAL R14,$IOCK WAIT FOR ECB TO BE POSTED 01590000 L R8,PCTCCW GET CCW COUNT 01591000 IC R6,=AL1(POPCODEI) WRITE SPACE OPCODE 01592000 KNOTIMM EQU * 01593000 STC R6,PCTOPCOD STORE CONTROL CHARACTER 01594000 OI PCTOPCOD,POPCODE OR IN 1 TO MAKE CTL CHAR CO 01595000 CLI PCTOPCOD,X'61' Q. IF FCB LOAD REQUEST 01596000 BNE PLINE BR IF NO 01597000 OI PCTOPCOD,X'02' CONVERT COMMAND TO X'63' 01598000 PLINE EQU * 01599000 MVI PCTECB,X'10' SHOW PRINT BUSY 01600000 L R1,PDEVFIOA GET DEVICE BLOCK ADDRESS 01601000 LA R6,PCTCCW GET CCW ADDRESS 01602000 ST R6,PROGADDR SET CAW WITH THIS ADDR 01603000 OC PCTCCW(1),PCTOPCOD RESET OPCODE 01604000 L R15,IOREQ SYSTEM I/O REQUEST 01605000 BALR R14,R15 GO EXECUTE THE I/O 01606000 BAL R14,$IOCK WAIT FOR ECB TO BE POSTED 01607000 L R8,PCTCCW GET CCW DATA ADDR 01608000 S R8,=A(TANKDATA-TANKDSEC) MOVE BACK TO BEGINNING OF TANK 01609000 PFREE EQU * 01610000 MVC 0(4,R8),$TANKPOL GET FIRST FREE OFF QUEUE 01611000 ST R8,$TANKPOL MAKE THIS ONE THE FIRST 01612000 MVI $TPGETCM+1,OPEN OPEN TPGET GATE 01613000 B PNEXT PRINT NEXT LINE 01614000 DROP R1 01615000 SPACE 1 01616000 * 01617000 * EQUATES FOR PRINT PROCESSOR 01618000 * 01619000 PSKIMM EQU X'20' SRCB FLAG TO SKIP IMMEDIATE 01620000 POPCODEI EQU X'09' PRINT OP-CODE SPACE 1 AFTER 01621000 PFLAGS EQU X'20' NO CHAINING,SUPPRESS WRONG LENGTH CK 01622000 POPCODE EQU X'01' CCW PRINT LINE OPCODE NO SPACE 1 01623000 PCCOP EQU X'03' CARRIAGE CONTROL OP-CODE 01624000 SPACE 1 01625000 PSPOVM EQU X'80' VM SPO FLAG 01626000 EJECT 01627000 *. 01628000 * 01629000 * ENTRY NAME - 01630000 * 01631000 * $URTN1 01632000 * 01633000 * FUNCTION - 01634000 * 01635000 * THIS ROUTINE DEQUEUES TANKS FROM ITS TANK QUEUE, OBTAINS 01636000 * A NEW OUTPUT SPOOL DEVICEIF NEEDED FROM DMTAXS, AND 01637000 * OUTPUTS THE TANK TO A VIRTUAL PUNCH. 01638000 * 01639000 * CALLS TO OTHER ROUTINES - 01640000 * 01641000 * DMTIOMRQ - TO INITIATE AN I/O OPERATION 01642000 * 01643000 * OPERATION - 01644000 * 01645000 * 1. OBTAIN A TANK FROM $GETTNK 01646000 * 01647000 * 2. IF OBTAINED CHECK TO SEE IF OUTPUT FILE IS OPENED, 01648000 * IF NOT OBTAIN A OUTPUT DEVICE BY A CALL TO AXS. 01649000 * 01650000 * 3. WRITE THE RECORD TO THE VM/370 SPOOL FILE SYSTEM. 01651000 * 01652000 * 4. WHEN EOF IS OBTAINED CLOSE THE FILE VIA ANOTHER CALL 01653000 * TO AXS. 01654000 * 01655000 * 5. EXIT TO COMMUTATOR 01656000 * 01657000 * RESPONSES - 01658000 * 01659000 * DMTSML144I RECEIVING: FILE FROM 'LOCID1' ('USERID1') FOR 01660000 * 'LOCID2' ('USERID2') 01661000 * DMTSML145I RECEIVED: FILE FROM 'LOCID1' ('USERID1') FOR 01662000 * 'LOCID2' ('USERID2') 01663000 * 01664000 * ERROR MESSAGES - 01665000 * 01666000 * NONE 01667000 * 01668000 *. 01669000 SPACE 3 01670000 USING TANKDSEC,R8 GET TANK ADDRESSABILITY 01671000 USING TCTDSECT,TCTR GET TCT ADDRESSABILITY 01672000 USING IOTABLE,R1 GET IOTABLE ADDRESSABILITY 01673000 SPACE 1 01674000 $URTN1 DS 0H INITIAL ENTRY AT IPL TIME,DUAL PUNCH 01675000 USTART DS 0H LOOP ENTRY TO CONTINUE PUNCHING 01676000 BAL R14,$GETTNK WAIT FOR THE NEXT TANK 01677000 CLI TANKCNT+1,0 TEST FOR END OF JOB 01678000 BNE UOUTPUT NO CONTINUE 01679000 UCLOSE EQU * 01680000 LA R1,UDEVSYNC GET DEVICE BLOCK ADDRESS 01681000 LA R0,X'12' INDICATE CLOSE 01682000 BAL R14,AXS GO CLOSE THE FILE 01683000 NI MASTERSW,255-PUNCH TURN OFF OPEN FLAG 01684000 OI UACON,ECBSKIP INDICATE ECB SKIP 01685000 MSG 145,(AXSLINK,SYSTYPE,LOCATION,BLANK) WRITE CLOSE@VM01105 01686000 B UFREE IF SO FREE TANK 01687000 SPACE 1 01688000 UOUTPUT DS 0H PUNCH THE CARD 01689000 TM MASTERSW,PUNCH SEE IF FILE ACTIVE 01690000 BO UOUT2 YES CONTINUE 01691000 LA R1,UDEVSYNC GET DEVICE BLOCK 01692000 LA R0,X'11' INDICATE OPEN 01693000 BAL R14,AXS GO GET A DEVICE 01694000 L R1,UDEVFIOA GET FIOA ADDRESS 01695000 ST R1,UACON STORE IN ECB LIST 01696000 XC 0(4,R1),0(R1) INITIALLY CLEAR SYNCH LOCK 01697000 OI MASTERSW,PUNCH INDICATE FILE OPEN 01698000 MSG 144,(AXSLINK,SYSTYPE,LOCATION,BLANK) WRITE RECV @VM01105 01699000 EJECT 01700000 UOUT2 EQU * 01701000 MVC UCTCCWCT+1(1),TANKCNT+1 SET COUNT IN CCW 01702000 LA R8,TANKDATA GET DATA ADDR 01703000 ST R8,UCTCCW STORE IN CCW 01704000 MVI UCTECB,X'10' SHOW PUNCH BUSY 01705000 OC UCTCCW(1),UCTOPCOD SET OPCODE 01706000 L R1,UDEVFIOA GET DEVICE BLOCK 01707000 LA R6,UCTCCW GET CCW ADDR 01708000 ST R6,PROGADDR SET IN CAW 01709000 L R15,IOREQ SYSTEM I/O REQUEST PROCESSOR 01710000 BALR R14,R15 GO EXECUTE THE I/O 01711000 BAL R14,$IOCK CHECK FOR I/O COMPLETE 01712000 L R8,UCTCCW PICK UP TANK ADDRESS 01713000 S R8,=A(TANKDATA-TANKDSEC) RESET TO BEGINNING OF TANK 01714000 UFREE EQU * 01715000 MVC 0(4,R8),$TANKPOL GET FIRST FREE OFF QUEUE 01716000 ST R8,$TANKPOL MAKE THIS ONE THE FIRST 01717000 MVI $TPGETCM+1,OPEN OPEN TPGET GATE 01718000 B USTART GO BACK TO START OF PROCESSOR 01719000 DROP R1 ALL DONE WITH THIS 01720000 SPACE 1 01721000 USPOVM EQU X'80' VM SPOOL 01722000 EJECT 01723000 *. 01724000 * 01725000 * ENTRY NAME - 01726000 * 01727000 * $JRTN1 01728000 * 01729000 * FUNCTION - 01730000 * 01731000 * THIS ROUTINE DEQUEUES TANKS FROM ITS TANK QUEUE, OBTAINS 01732000 * A NEW OUTPUT SPOOL DEVICE IF NEEDED FROM DMTAXS, AND 01733000 * OUTPUTS THE TANK TO A VIRTUAL PUNCH. 01734000 * 01735000 * CALLS TO OTHER ROUTINES - 01736000 * 01737000 * DMTIOMRQ - TO INITIATE AN I/O OPERATION 01738000 * 01739000 * OPERATION - 01740000 * 01741000 * 1. OBTAIN A TANK FROM $GETTNK 01742000 * 01743000 * 2. IF OBTAINED CHECK TO SEE IF OUTPUT FILE IS OPENED, 01744000 * IF NOT OBTAIN A OUTPUT DEVICE BY A CALL TO AXS. 01745000 * 01746000 * 3. VIA A CALL TO $USREXIT VALIDATE THE INFORMATION ON 01747000 * THE ID CARD. 01748000 * 01749000 * 4. WRITE THE RECORD TO THE VM/370 SPOOL FILE SYSTEM. 01750000 * 01751000 * 5. WHEH EOF IS OBTAINED CLOSE THE FILE VIA ANOTHER CALL 01752000 * TO AXS. 01753000 * 01754000 * 6. EXIT TO COMMUTATOR 01755000 * 01756000 * RESPONSES - 01757000 * 01758000 * DMTSML144I RECEIVING: FILE FROM 'LOCID1' ('USERID1') FOR 01759000 * 'LOCID2' ('USERID2') 01760000 * DMTSML145I RECEIVED: FILE FROM 'LOCID1' ('USERID1') FOR 01761000 * 'LOCID2' ('USERID2') 01762000 * 01763000 * ERROR MESSAGES - 01764000 * 01765000 * NONE 01766000 * 01767000 *. 01768000 SPACE 1 01769000 USING TANKDSEC,R8 01770000 USING TCTDSECT,TCTR 01771000 USING TAG,R1 GET TAG ADDRESSABILITY 01772000 $JRTN1 DS 0H INITIAL ENTRY AT IPL TIME 01773000 JSTART DS 0H LOOP ENTRY TO CONTINUE PUNCHING 01774000 BAL R14,$GETTNK WAIT FOR THE NEXT TANK 01775000 CLI TANKCNT+1,0 TEST FOR END OF JOB 01776000 BNE JOUTPUT NO CONTINUE 01777000 JCLOSE EQU * 01778000 XC $USRCMDC(2),$USRCMDC CLEAR INPUT CMD COUNT @VA04612 01779000 TM MASTERSW,JOB WAS A FILE EVER OPENED? 01780000 BO JCLOSE1 YES CONTINUE 01781000 NI JSW2,255-JNOID RESET ID CARD MISSING FLAG @VA04612 01782000 B JFREE AND EXIT 01783000 SPACE 1 01784000 JCLOSE1 EQU * 01785000 L R15,JDEVFIOA GET IOTABLE ADDRESS 01786000 UNPK TAGCMD+7(5),DEVCUU-IOTABLE(3,R15) UNPK THE DEV ADDR 01787000 MVI TAGCMD+7,C' ' RESTORE THE CLOBBERED BLANK 01788000 MVI TAGCMD+11,C' ' RESTORE THE CLOBBERED BLANK 01789000 TR TAGCMD+8(3),AXSTRTAB-240 TRANSLATE TO LEGAL EBCDIC 01790000 LA R1,TAGCMD GET TAG COMMAND ADDR 01791000 LA R2,TAGCMDL AND THE LENGTH 01792000 DIAG R1,R2,X'08' AND ISSUE THE COMMAND 01793000 MVI TAGDATA,C' ' CLEAR FIRST BYTE OF FIELD 01794000 MVC TAGDATA+1(69),TAGDATA AND THE REST OF FIELD 01795000 LA R1,JDEVSYNC GET DEVICE BLOCK ADDRESS 01796000 LA R0,X'12' INDICATE CLOSE 01797000 BAL R14,AXS GO CLOSE THE FILE 01798000 MSG 145,(AXSLINK,SYSTYPE,LOCATION,JCTTOVM) WRITE CLO@VM01105 01799000 NI MASTERSW,255-JOB TURN OFF OPEN FLAG 01800000 NI JSW1,255-JSPOVM RESET FLAG 01801000 OI JACON,ECBSKIP INDICATE ECB SKIP 01802000 LA R1,JTAG GET TAG ADDRESS 01803000 MVC TAGTOVM(8),BLANK BLANK OUT TAG 01804000 MVC JCTTOVM(8),BLANK BLANK OUT DESTINATION 01805000 B JFREE IF SO FREE TANK 01806000 EJECT 01807000 JOUTPUT DS 0H JOB THE CARD 01808000 TM MASTERSW,JOB SEE IF FILE ACTIVE 01809000 BO JOUT1 YES CONTINUE 01810000 BAL R14,$USREXIT SEE CARD MUST BE MODIFIED 01811000 BP JFREE NON 0 DONT PROCESS RECORD 01812000 TM JSW1,JSPOVM ARE WE SPOOLING YET 01813000 BNO JFREE NO..SKIP IT 01814000 LA R1,JTAG GET THE TAG ADDRESS 01815000 MVC TAGTOVM(8),JCTTOVM MOVE IN DESTINATION 01816000 LA R1,JDEVSYNC GET DEVICE BLOCK 01817000 LA R0,X'11' INDICATE OPEN 01818000 BAL R14,AXS GO GET A DEVICE 01819000 L R1,JDEVFIOA GET FIOA ADDRESS 01820000 XC 0(4,R1),0(R1) INITIALIALLY CLEAR SYNCH LOCK 01821000 ST R1,JACON STORE IN ECB LIST 01822000 OI MASTERSW,JOB INDICATE FILE OPEN 01823000 MSG 144,(AXSLINK,SYSTYPE,LOCATION,JCTTOVM) WRITE REC@VM01105 01824000 B JFREE FREE THE TANK 01825000 SPACE 1 01826000 JOUT1 EQU * 01827000 MVC JCTCCWCT+1(1),TANKCNT+1 SET COUNT IN CCW 01828000 LA R8,TANKDATA GET DATA ADDR 01829000 ST R8,JCTCCW STORE IN CCW 01830000 MVI JCTECB,X'10' SHOW PUNCH BUSY 01831000 OC JCTCCW(1),JCTOPCOD SET OPCODE 01832000 L R1,JDEVFIOA GET DEVICE BLOCK 01833000 LA R6,JCTCCW GET CCW ADDR 01834000 ST R6,PROGADDR-IOTABLE(R1) SET IN CAW 01835000 L R15,IOREQ SYSTEM I/O REWUEST PROCESSOR 01836000 BALR R14,R15 GO EXECUTE THE I/O 01837000 BAL R14,$IOCK CHECK FOR I/O COMPLETE 01838000 L R8,JCTCCW PICK UP TANK ADDRESS 01839000 S R8,=A(TANKDATA-TANKDSEC) RESET TO BEGINNING OF TANK 01840000 JFREE EQU * 01841000 MVC 0(4,R8),$TANKPOL GET FIRST FREE OFF QUEUE 01842000 ST R8,$TANKPOL MAKE THIS ONE THE FIRST 01843000 MVI $TPGETCM+1,OPEN OPEN TPGET GATE 01844000 B JSTART GO BACK TO START OF PROCESSOR 01845000 DROP R1 DROP ADDRESSABILITY 01846000 SPACE 1 01847000 JSPOVM EQU X'40' SPO TO VM FLAG 01848000 EJECT 01849000 *. 01850000 * 01851000 * ENTRY NAME - 01852000 * 01853000 * $USREXIT 01854000 * 01855000 * FUNCTION - 01856000 * 01857000 * TO VALIDATE THE 'ID' CARD ON THE FRONT OF DECKS INPUTTED 01858000 * FROM A REMOTE CARD READER. 01859000 * 01860000 * CALLS TO OTHER ROUTINES - 01861000 * 01862000 * NONE 01863000 * 01864000 * OPERATION - 01865000 * 01866000 * 1. SEE IF THE TANK CONTAINS AN ID CARD. 01867000 * IT NOT EXIT. 01868000 * 01869000 * 2. IF ID CARD IS FOUND VALIDATE LENGTH OF USERID AND 01870000 * MOVE TO THE JCTTOVM FIELD IN THE TCT. 01871000 * 01872000 * 3. ANY OTHER TEXT ON THE ID CARD IS SAVED FOR USE AS THE 01873000 * TAG COMMAND TEXT. 01874000 * 01875000 * 4. SET RETURN CODE AND RETURN TO CALLER. 01876000 * 01877000 * 01878000 * RESPONSES - 01879000 * 01880000 * DMTSML570I LINK 'LINKID' NOW SET TO DEACTIVATE 01881000 * 01882000 * ERROR MESSAGES - 01883000 * 01884000 * DMTSML934E ID CARD MISSING ON LINK 'LINKID' 01885000 * INPUT FILE PURGED 01886000 * 01887000 *. 01888000 SPACE 3 01889000 USING TANKDSEC,R8 01890000 SPACE 1 01891000 $USREXIT DS 0H 01892000 ST R14,USERSAVE SAVE RETURN 01893000 TM JSW2,JNOID ALREADY RECEIVING FILE WITHOUT @VA04612 01894000 * IT? 01895000 BO $USRNPN1 YES - SKIP THE CARD @VA04612 01896000 CLC TANKDATA(9),=C'ID ' IS IT AN ID CARD 01897000 BNE $USRNPUN NOPE CONTINUE 01898000 LA R3,TANKDATA+9 GET THE FIRST VMID POSITION 01899000 LA R5,TANKDATA+20 AND THE LAST POSITION 01900000 BAL R14,PARMGET FRAME THE USERID 01901000 CLR R3,R5 ANYTHING THERE 01902000 BNL $USRNPN1 SKIP THE ID CARD @VA03275 01903000 SLR R4,R3 COMPUTE THE LENGTH OF USERID 01904000 CL R4,USERMAX TOO LONG? 01905000 BH $USRNPN1 YES...IGNORE IT @VA03275 01906000 LR R14,R3 SAVE R3 FOR MVC @VM01152 01907000 LA R3,1(R4,R3) COMPUTE THE START OF TAG STRING 01908000 BCTR R4,0 REDUCE BY ONE FOR CHAR OP 01909000 EX R4,USERMVC MOVE THE USERID 01910000 LA R5,TANKDATA+79 LAST TAG POSITION 01911000 SLR R5,R3 LENGTH OF TAG DATA 01912000 BCTR R5,0 DOWN BY ONE FOR MVC 01913000 EX R5,TAGMVC MOVE INTO TAG CMD 01914000 OI JSW1,JSPOVM WE ARE NOW SPOOLING 01915000 B $USRPUN AND CONTINUE 01916000 SPACE 1 01917000 $USRNPUN EQU * 01918000 CLC TANKDATA(9),=C'/*SIGNOFF' IS IT A SIGNOFF CARD? 01919000 BNE $USRCMD MIGHT BE A COMMAND @VA03275 01920000 L R6,SMLLINK GET LINK TABLE ENTRY 01921000 OI LFLAG,LDRAIN INDICATE WE ARE DRAINING 01922000 MVC MSGLINK(8),AXSLINK INDICATE RESPONSE 01923000 MSG 570,AXSLINK WRITE MSG 01924000 B $USRNPN1 AND CONTINUE @VA03275 01925000 SPACE 1 01926000 $USRCMD EQU * @VA03275 01927000 CLC TANKDATA(5),=C'/*EOF' LAST COMMAND CARD? @VA03275 01928000 BE $USRNPN1 YES..ALL DONE @VA03275 01929000 L R15,JCTTANK GET NEXT TANK ADDR @VA04612 01930000 CLI 7(R15),X'00' NULL LINE ? @VA04612 01931000 BNE $USRNOID NO => ID CARD MISSING @VA04612 01932000 * YES => IT IS A COMMAND 01933000 LH R14,$USRCMDC RETRIEVE COMMAND COUNT @VA04612 01934000 CH R14,=H'10' NUM OF COMMANDS 7 10 ? @VA04612 01935000 BH $USRNPN1 YES..SKIP PROCESSING THIS RECORD @VA04612 01936000 LA R14,1(R14) UP THE COMMAND COUNT @VA04612 01937000 STH R14,$USRCMDC AND SAVE IT @VA04612 01938000 LA R5,WCTTANK GET CONSOLE TANK Q POINTER @VA04612 01939000 $USRNEXT CLC 0(4,R5),=F'0' GET @VA04612 01940000 BE $USRLAST THE LAST @VA04612 01941000 L R5,0(0,R5) IN THE @VA04612 01942000 B $USRNEXT QUEUE @VA04612 01943000 $USRLAST ST R8,0(0,R5) CHAIN THE COMMAND TO IT @VA04612 01944000 MVC 0(4,R8),=F'0' MAKE THIS THE FIRST @VA04612 01945000 LH R5,WCTTNKLM ADJUST @VA04612 01946000 LA R5,1(R5) CONSOLE TANK @VA04612 01947000 STH R5,WCTTNKLM COUNT @VA04612 01948000 MVI $WCOMM1+1,OPEN OPEN CONSOLE GATE @VA04612 01949000 B $USRNPN1 RETURN FOR NEXT RECORD @VA04612 01950000 $USRNOID OI JSW2,JNOID SET ID CARD MISSING FLAG @VA04612 01951000 MSG 934,AXSLINK SEND ERROR MSG @VA04612 01952000 SPACE 1 01953000 $USRNPN1 EQU * 01954000 LA R15,4 SET NON-ZERO RETURN CODE 01955000 B $USREXT1 ENTER COMMON EXIT POINT 01956000 SPACE 1 01957000 $USRPUN EQU * 01958000 SR R15,R15 SET ZERO RETURN CODE 01959000 SPACE 1 01960000 $USREXT1 EQU * 01961000 L R14,USERSAVE RESTORE RETURN REG 01962000 LTR R15,R15 SET CONDITION CODE 01963000 BR R14 RETURN 01964000 SPACE 01965000 JNOID EQU X'80' ID CARD MISSING FLAG @VA04612 01966000 SPACE 01967000 $USRCMDC DC H'0' NUM OF USER COMMANDS @VA04612 01968000 EJECT 01969000 USERMVC MVC JCTTOVM(0),0(R14) TO BE EXECUTED FROM ABOVE @VM01152 01970000 TAGMVC MVC TAGDATA(0),0(R3) TO BE EXECUTED FROM ABOVE 01971000 SPACE 01972000 USERMAX DC F'8' MAXIMUM LENGTH OF USERID FIELD 01973000 USERSAVE DC F'0' SAVE AREA 01974000 SPACE 01975000 TAGCMD DC C'TAG DEV XXX ' TAG COMMAND 01976000 TAGDATA DC CL70' ' DATA FIELD 01977000 TAGCMDL EQU *-TAGCMD LENGTH OF TAG COMMAND 01978000 SPACE 1 01979000 USERGIV DC F'0' SYNCH LOCK @VA03275 01980000 DC CL4'REX' TASK TO RECEIVE IT @VA03275 01981000 DC 2A(0) TO BE FILLED IN @VA03275 01982000 EJECT 01983000 *---------------------------------------------------------------------* 01984000 * * 01985000 * UNIT RECORD WAIT ROUTINE * 01986000 * * 01987000 *---------------------------------------------------------------------* 01988000 SPACE 1 01989000 USING TANKDSEC,R8 GET TANK ADDRESSABILITY 01990000 USING TCTDSECT,TCTR GET TCT ADDRESSABILITY 01991000 SPACE 3 01992000 DS 0H 01993000 YOCLOSE EQU * 01994000 L R14,TCTCOM CLOSE COMMUTATOR 01995000 MVI 1(R14),CLOSE CHANGE BR TO NOP 01996000 * IF DEVICE BUSY DEVICE END INTERRUPT WILL CLEAR 01997000 * IF DEVICE NOT READY DEVICE END WILL CLEAR 01998000 BR R14 RETURN TO CALLER 01999000 SPACE 1 02000000 * $IOCK ENTRY POINT TO PASS TO USER CODES 02001000 * 02002000 $IOCK EQU * 02003000 ST R14,TCTSAV1 SAVE USER RETURN ADDRESS 02004000 MVC TCTENTY(2),YACN1 GET READY FOR DELAY 02005000 B YOCLOSE AND CONTINUE 02006000 SPACE 1 02007000 YOCKRET EQU * 02008000 TM TCTECB,X'10' IS THE DEVICE FREE??? 02009000 BO YOCLOSE ALL DONE 02010000 L R14,TCTSAV1 RESTORE REG 02011000 BR R14 RETURN TO CALLER 02012000 SPACE 1 02013000 YACN1 DC S(YOCKRET) RETURN ENTRY POINT 02014000 EJECT 02015000 *. 02016000 * 02017000 * ENTRY NAME - 02018000 * 02019000 * $RRTN1 02020000 * 02021000 * FUNCTION - 02022000 * 02023000 * THIS ROUTINE INPUTS FILES FROM THE VM/370 SPOOL FILE 02024000 * SYSTEM, DEBLOKS THEM INTO 132 BYTE RECORDS AND ISSUES A 02025000 * CALL TO $PUT TO BLOCK THE RECORD INTO A TRANSMISSION 02026000 * BUFFER. 02027000 * 02028000 * CALLS TO OTHER ROUTINES - 02029000 * 02030000 * NONE 02031000 * 02032000 * OPERATION - 02033000 * 02034000 * 1. IF NEEDED OPEN A NEW FILE TO TRANSMIT VIA CALL TO AXSGET. 02035000 * 02036000 * 2. TEST FOR READER TYPE AND MODIFY READER RCB TO REFLECT 02037000 * MODE AND FILE TYPE. 02038000 * 02039000 * 3. SEND AND WAIT FOR A REPLY FOR A PERMISSION TO TRANSMIT 02040000 * RECORD. 02041000 * 02042000 * 4. GET A RECORD TO TRANSMIT VIA CALL TO VMDEBLOK 02043000 * 02044000 * 5. TEST FOR A READER COMMAND PENDING BY CHECKING RDRCMD 02045000 * BYTE. 02046000 * 02047000 * 6. IF EOF PURGE THE FILE, TRANSMIT EOF RECORD AND TRY 02048000 * TO OBTAIN ANOTHER FILE. 02049000 * 02050000 * RESPONSES - 02051000 * 02052000 * DMTSML146I SENDING: FILE 'SPOOLID' ON LINK 'LINKID', 02053000 * REC NNNNNN 02054000 * DMTSML147I SENT: FILE'SPOOLID' ON LINK 'LINKID' 02055000 * DMTSML580I FILE 'SPOOLID' PROCESSING TERMINATED 02056000 * DMTSML611I LINK 'LINKID' FILE TRANSMISSION SUSPENDED 02057000 * DMTSML510I FILE 'SPOOLID' BACKSPACED 02058000 * DMTSML600I FILE 'SPOOLID' FORWARD SPACED 02059000 * 02060000 * ERROR MESSAGES - 02061000 * 02062000 * DMTSML581E FILE 'SPOOLID' NOT ACTIVE 02063000 * DMTSML935E LINK 'LINKID' IN RJE MODE -- PRINT FILE 'SPOOLID' 02064000 * PURGED 02065000 * 02066000 *. 02067000 EJECT 02068000 * 02069000 * INPUT SERVICE PROCESSOR 02070000 * 02071000 SPACE 1 02072000 $RRTN1 DS 0H INITIAL ENTRY AT IPL TIME 02073000 USING TCTDSECT,TCTR GET TCT ADDRESSABILTIY 02074000 USING TAG,R8 GET TAG ADDRESSABILTIY 02075000 READ1 EQU * 02076000 L R6,SMLLINK GET LINK TABLE ADDRESS @VA03110 02077000 TM LFLAG,LHOLD IS THE LINK HELD @VA03110 02078000 BO READHLD YES..EXIT @VA03110 02079000 TM RDRCMD,RHLDIPGS IS A HOLD IN PROGRESS? 02080000 BNO RDNOHLD NO CONTINUE 02081000 READHLD EQU * @VA03110 02082000 MVC RCTENTY(2),RACN4 REENTER AT READ1 02083000 L R8,RCTCOM GET THIS COMMUTATOR ADDR 02084000 MVI 1(R8),CLOSE CLOSE THE GATE 02085000 B RCTRTN AND EXIT 02086000 SPACE 1 02087000 RDNOHLD EQU * 02088000 MVI RCTTSRC1,X'80' RESET SRCB 02089000 MVI RCTRCBT,RRCB1 RESET JOB RCB 02090000 MVI RCTTRCB1,RRCB1 RESET JOB RCB 02091000 MVI RCTECB,X'10' SHOW READER BUSY 02092000 BAL R14,AXSGET TRY TO OPEN READER FILE 02093000 BNZ RDERR1 NO FILES FOR NOW 02094000 SPACE 1 02095000 L R8,RDEVTAG GET TAG ADDRESS 02096000 LH R1,TAGID GET SPOOL FILE ID 02097000 CVD R1,AXSCVD CONVERT TO DECIMAL 02098000 UNPK AXSFILE,AXSCVD SPREAD THE DIGITS 02099000 OI AXSFILE+3,X'F0' AND MAKE SURE LAST IS PRINTABLE 02100000 L R1,TAGRECNM GET NUMBER OF RECS IN FILE 02101000 CVD R1,AXSCVD CONVERT TO DECIMAL 02102000 UNPK AXSRECS,AXSCVD SPREAD THE DIGITS 02103000 OI AXSRECS+7,X'F0' MAKE SURE LAST IS PRINTABLE 02104000 MVC HDRFILE(4),AXSFILE MOVE FILE ID INTO MSG 02105000 MVC HDRRECS(8),AXSRECS AND THE NUMBER OF RECS 02106000 MVC MSGVMID(8),TAGINVM MOVE VMID INTO MSG 02107000 CLI TAGINDEV,TYP3210 IS IT SPOOLED CONSOLE OUTPUT 02108000 BE READCON YES..TREAT LIKE PRINT FILE 02109000 TM TAGINDEV,TYPPRT IS IT A PRINT FILE 02110000 BNO READ2 NO CONTINUE 02111000 READCON EQU * 02112000 TM SMLSYS,MASTER ARE PRT TYPE FILES ALLOWED 02113000 BO READ1A YES CONTINUE CHECK 02114000 BAL R14,AXSPURGE GET RID OF THIS FILE 02115000 MSG 935,(AXSLINK,AXSFILE) WRITE ERROR MSG 02116000 B READ1 AND GET THE NEXT ONE 02117000 SPACE 1 02118000 READ1A EQU * 02119000 MVI RCTRCBT,PRCB1 SET THE RCB TYPE FOR PRT 02120000 MVI RCTTRCB1,PRCB1 SET THE RCB TYPE FOR PRT 02121000 OI RSW1,PTRANS INDICATE TRANSMITTING PRT FILE 02122000 B ROPEN GO INITIATE THE TRANSMISSION 02123000 SPACE 1 02124000 READ2 EQU * 02125000 TM SMLSYS,HASP+RES+ASP JOBS ONLY? 02126000 BM ROPEN MUST BE JOBS SO SKIP THE REST 02127000 SPACE 1 02128000 READ3 EQU * 02129000 OI RSW1,UTRANS INDICATE TRANSMITTING PUNCH OUTPUT 02130000 MVI RCTRCBT,URCB1 SET THE RCB TYPE 02131000 MVI RCTTRCB1,URCB1 SET THE RCB TYPE 02132000 EJECT 02133000 ROPEN EQU * 02134000 TM MASTERSW,READER IS THERE A READER OPEN 02135000 BO ROPEN1 READER IS ACTIVE 02136000 LA R8,RCTTANK1 LOCATE TANK IN PARAMETER REG 02137000 BAL R14,$TPOPEN REQUEST OTHER END TO RECEIVE STREAM 02138000 BZ RREOPEN IF NOT SENT WAIT 02139000 MVC RCTTCT1,=H'80' RESET LENGTH 02140000 MVC RCTENTY(2),RACN1 WAIT FOR RESPONSE 02141000 L R8,RCTCOM CLOSE GATE REENTER ELSEWERE 02142000 MVI 1(R8),CLOSE CLOSE THE GATE 02143000 B RCTRTN AND RETURN 02144000 SPACE 1 02145000 RLOC1 EQU * 02146000 OI MASTERSW,READER INDICATE THAT THE READER IS OPEN 02147000 MSG 146,(AXSFILE,AXSLINK,AXSRECS) WRITE MSG 02148000 EJECT 02149000 ROPEN1 EQU * 02150000 RDLOOP DS 0H BASIC READ LOOP 02151000 TM SMLSYS,MASTER IN HOST MODE? 02152000 BNO RDLOPA NO CONTINUE 02153000 TM RSW1,HEADFLAG SENDING HEADER? 02154000 BNO RDLOPA NO CONTINUE 02155000 BAL R14,HEADPREP GET A HEADER LINE 02156000 B RDLOPB AND PUT THE RECORD 02157000 SPACE 1 02158000 RDLOPA EQU * 02159000 BAL R14,VMDEBLOK GO GET A LINE TO SEND 02160000 BNZ RDEOF E-O-F 02161000 RDLOPB EQU * 02162000 CLI RCTOPCOD,X'03' IS IT A TAG RECORD 02163000 BE RDLOOP YES TRY AGAIN 02164000 TM RSW1,UTRANS ARE WE SENDING PUNCH OUTPUT? 02165000 BNO RDLOP0 NO CONTINUE 02166000 MVI RCTTSRC1,X'81' SET PUNCH SRCB 02167000 RDLOP0 EQU * 02168000 TM RSW1,PTRANS ARE WE SENDING PRINT? 02169000 BNO RDLOP1 NO OKAY TO PUT 02170000 MVC RCTTCT1(2),RCTCCWCT SET THE LENGTH OF PRT DATA 02171000 SR R8,R8 CLEAR FOR IC 02172000 IC R8,RCTOPCOD GET THE OP CODE FOR PRINTER FILE 02173000 SRL R8,3 SET THE SRCB 02174000 STC R8,RCTTSRC1 AND STORE IN TANK 02175000 OI RCTTSRC1,X'80' INSURE TOP BIT IS ON 02176000 B RDLOP2 AND CONTINUE 02177000 SPACE 1 02178000 RDLOP1 EQU * 02179000 MVC RCTTCT1,=H'80' RESET LENGTH 02180000 RDLOP2 EQU * 02181000 LA R8,RCTTANK1 GET THE TANK ADDRESS 02182000 BAL R14,$PUT AND WRITE THE TANK 02183000 CLI RDRCMD,X'00' ANY COMMAND PENDING? 02184000 BE RDLOOP NO CONTINUE 02185000 TM RDRCMD,RBACKCNT BACKSPAC COUNT? 02186000 BO RBACKUP YES PROCESS IT 02187000 TM RDRCMD,RFWDCNT FORWARD SPACE COUNT? 02188000 BO RGOFWD YES PROCESS IT 02189000 TM RDRCMD,RBACKFIL BACKSPAC FILE? 02190000 BO RDBACKFL GO DO IT 02191000 TM RDRCMD,RFLSHALL FLUSH ALL? 02192000 BNO RDLOP3 NO CONTINUE 02193000 OI RDEVSOPT,ALL INDICATE FLUSH ALL IN RDR 02194000 B RDFLUSH GO DO IT @VA04039 02195000 RDLOP3 EQU * 02196000 TM RDRCMD,RFLSHOLD FLUSH AND HOLD? 02197000 BNO RDCKFLSH MIGHT BE FLUSH COPY @VA03276 02198000 OI RDEVSOPT,HOLD INDICATE FLUSH AND HOLD 02199000 B RDFLUSH GO DO IT @VA04039 02200000 RDCKFLSH EQU * @VA03276 02201000 TM RDRCMD,RFLSHCPY FLUSH COPY? @VA03276 02202000 BO RDFLUSH YES..GO DO IT @VA03276 02203000 B RDLOOP CONTINUE @VA03276 02204000 EJECT 02205000 RDFLUSH EQU * 02206000 NI RDRCMD,255-RFLSHALL-RFLSHOLD-RFLSHCPY RESET CMD BYTE 02207000 MVC MSGLINK(8),RDRCMDLK MOVE RESPONSE ID INTO MSG 02208000 CLC CMDFID(4),AXSFILE RIGHT FILE? 02209000 BNE RDFLSHER NO..ERROR 02210000 MSG 580,AXSFILE WRITE THE FLUSH MSG 02211000 B RDEOF0 AND CONTINUE 02212000 SPACE 02213000 RDFLSHER EQU * 02214000 MSG 581,CMDFID WRITE ERROR MSG 02215000 B RDLOOP AND CONTINUE 02216000 EJECT 02217000 RDEOF EQU * 02218000 MSG 147,(AXSFILE,AXSLINK) WRITE CLOSE MSG 02219000 RDEOF0 EQU * 02220000 NI RSW1,255-CLINE NO BUFFER PRESENT 02221000 OI RCTECB,TCTBUSY SET READER BUSY FOR WAITING 02222000 MVI RCTWFB,X'00' RESET WAITING FOR BUFFER SW 02223000 OI RSW1,RINIT INITIAL CALL HAS OCCURED 02224000 RDEOF1 EQU * 02225000 BAL R14,AXSPURGE GET RID OF FILE 02226000 NI RSW1,255-RINIT-PTRANS-UTRANS TURN OFF FLAGS 02227000 NI MASTERSW,255-READER TURN OFF READER ACTIVE 02228000 MVC RCTTCT1,=F'0' SET END OF FILE INDICATOR 02229000 MVC RCTENTY(2),RACN2 02230000 RLOC2 EQU * 02231000 MVI RCTWFB,X'00' RESET WAITING FOR BUFFERS SW @VA03306 02232000 LA R8,RCTTANK1 GET TANK ADDRESS 02233000 BAL R14,$TPPUT PUT THE TANK 02234000 BNZ READ1 GO GET ANOTHER FILE 02235000 L R8,RCTCOM GET COMMUTATOR ENTRY 02236000 MVI 1(R8),CLOSE AND CLOSE THE GATE 02237000 MVI RCTWFB,X'FF' SHOW WAITING FOR A BUFFER 02238000 B RCTRTN GO WAIT FOR A BUFFER 02239000 EJECT 02240000 RDBACKFL EQU * 02241000 USING SPLINK,R1 GET SPLINK ADDRESSABILITY 02242000 L R1,RDEVFIOA GET FILE I/O AREA ADDRESS 02243000 L R8,RDEVTAG GET TAG ADDRESS 02244000 LH R2,TAGDEV GET READER ADDRESS 02245000 LA R3,X'14' INDICATE BACKSPACE FILE 02246000 DIAG R1,R2,X'14' COMMAND SPOOL READER 02247000 RDBKFIL1 EQU * 02248000 NI RSW1,255-CLINE INDICATE BLOCK NOT PRESENT 02249000 RDBKFIL2 EQU * 02250000 LA R8,RDLOOP INDICATE RETURN POINT 02251000 RDBKMSG EQU * 02252000 MVC MSGLINK(8),RDRCMDLK MOVE IN RESPONSE LINKID 02253000 MSG 510,AXSFILE WRITE BACKSPAC MSG 02254000 NI RDRCMD,255-RBACKFIL-RBACKCNT RESET CMD FLAGS 02255000 BR R8 AND CONTINUE 02256000 EJECT 02257000 RBACKUP EQU * 02258000 L R1,RDEVFIOA GET FIOA ADDR 02259000 L R8,RDEVTAG GET READER TAG ADDRESS 02260000 L R3,SPRECNUM AND NUMBER OF RECORDS 02261000 S R3,VMSPNUM SUBSTRACT WHATS LEFT 02262000 BZ RDBKPAGA ALL DONE WITH THIS PAGE 02263000 LA R4,SPRECNUM+4 GET DATA ADDR 02264000 ST R4,VMSPANCH STORE ANCHOR FOR UNPACK 02265000 ST R4,VMSPNEXT AND THE NEXT DATA STRING 02266000 ST R3,VMSPNUM STORE THE NEW COUNT 02267000 OI RSW1,CLINE FILE ALREADY HERE @VA10237 02267100 TM TAGINDEV,TYPPUN IS IT A PUNCH FILE? 02268000 BNO RBACKCN2 NO..MUST BE PRINT 02269000 L R3,VMSPNUM GET THE CURRENT COUNT 02270000 B RBACKCN3 AND CONTINUE 02271000 SPACE 1 02272000 RBACKCN1 EQU * 02273000 LPR R3,R3 MAKE POSITIVE 02274000 ST R3,RDRCMDCT UPDATE NUMBER OF BACKS 02275000 RDBKPAGA EQU * 02276000 BAL R14,RDBKPAGE GO BACKPAGE 02277000 RBACKCN2 EQU * 02278000 TM TAGINDEV,TYPPRT IS IT A PRINT FILE? 02279000 BO RCNTSKP YES..MUST SKIP PAGES NOT RECS 02280000 L R3,SPRECNUM GET THE NEW NUM OF RECORDS 02281000 RBACKCN3 EQU * 02282000 S R3,RDRCMDCT SUBSTRACT NEW NUM 02283000 LTR R3,R3 ARE WE DONE? 02284000 BNP RBACKCN1 NO CONTINUE 02285000 BAL R14,RDBKPCON RESET TO BEGINNING OF PAGE 02286000 RBACKSK EQU * 02287000 BAL R14,VMDEBLOK GET A RECORD 02288000 TM TAGINDEV,TYPPUN IS IT A PUNCH FILE? 02289000 BO RBACKDWN YES COUNT ALL 02290000 CLI RCTOPCOD,X'89' PRINT AND SKIP TO CHAN 1? 02291000 BE RBACKDWN YES COUNT IT 02292000 CLI RCTOPCOD,X'8B' IMMED SKIP TO CHAN 1? 02293000 BNE RBACKSK NO TRY ANOTHER 02294000 RBACKDWN EQU * 02295000 BCT R3,RBACKSK DOWN BY ONE 02296000 LA R8,RDLOPB INDICATE RETURN POINT 02297000 CLI RCTOPCOD,X'8B' IS IT A SKIP IMMED? 02298000 BE RDBKMSG YES..CONTINUE 02299000 MVI RCTOPCOD,X'8B' MAKE IT A SKIP IMMED.. 02300000 MVI RCTTDTA1,C' ' AND ONE CHAR OF DATA 02301000 LA R1,1 ONE BYTE OF DATA 02302000 STH R1,RCTCCWCT AND STORE IN CCW 02303000 B RDBKMSG ALL DONE 02304000 EJECT 02305000 RCNTSKP EQU * 02306000 SR R3,R3 ZERO OUT ACCUMLATOR 02307000 RCNTSKP1 EQU * 02308000 BAL R14,VMDEBLOK GET A RECORD 02309000 CLI RCTOPCOD,X'89' PRINT AND SKIP TO CHANNEL 1? 02310000 BE RCNTSKPC YES COUNT IT 02311000 CLI RCTOPCOD,X'8B' IMMED SKIP TO CHANNEL 1? 02312000 BE RCNTSKPC YES COUNT IT 02313000 RCNTSKPX EQU * 02314000 ICM R0,B'1111',VMSPNUM ALL DONE WITH PAGE? 02315000 BNZ RCNTSKP1 NO CONTINUE 02316000 B RBACKCN3 BR BACK TO MAIN CODE 02317000 SPACE 1 02318000 RCNTSKPC EQU * 02319000 LA R3,1(,R3) UP SKIP COUNT BY 1 02320000 B RCNTSKPX AND JOIN COMMON CODE 02321000 SPACE 1 02322000 RDBKPAGE EQU * BACK UP A PAGE SUBROUTINE 02323000 STM R0,R15,VMDESAVE MIGHT AS WELL SAVE THEM ALL 02324000 L R1,RDEVFIOA GET FILE I/O AREA ADDRESS 02325000 L R8,RDEVTAG GET TAG ADDRESS 02326000 LH R2,TAGDEV GET READER ADDRESS 02327000 LA R3,X'18' INDICATE BACKSPACE PAGE 02328000 DIAG R1,R2,X'14' COMMAND SPOOL READER 02329000 BC 4,RDBKPAG2 ALL DONE BEGINNING OF FILE 02330000 RDBKPAG1 EQU * 02331000 L R8,SPRECNUM PICKUP SPRECNUM FROM NEW BLOCK 02332000 ST R8,VMSPNUM PICKUP COUNT OF REMAINING CCWS 02333000 LA R8,SPRECNUM+4 SETP OVER POINTERS IN SPOOL BLOCK 02334000 ST R8,VMSPANCH TO PICKUP CURRENT CCW ANCHOR 02335000 ST R8,VMSPNEXT CCW POINTER AND NEXT 02336000 OI RSW1,CLINE TO INDICATE BLOCK PRESENT 02337000 LM R0,R15,VMDESAVE RESTORE REGS 02338000 BR R14 AND RETURN 02339000 SPACE 1 02340000 RDBKPAG2 EQU * 02341000 LA R14,RDBKFIL2 SET RETURN POINT 02342000 SPACE 1 02343000 RDBKPCON EQU * 02344000 STM R0,R15,VMDESAVE SAVE REGISTERS 02345000 B RDBKPAG1 AND SIMULATE A PAGE BACK 02346000 EJECT 02347000 RGOFWD EQU * 02348000 L R1,RDRCMDCT GET FWD COUNT 02349000 L R8,RDEVTAG AND THE TAG ADDR 02350000 RGOFWDLP EQU * 02351000 BAL R14,VMDEBLOK GO GET A RECORD 02352000 BNZ RDGODNE ALL DONE EOF 02353000 TM TAGINDEV,TYPPUN IS IT A PUNCH FILE? 02354000 BO RGOCNT COUNT ALL RECORDS 02355000 CLI RCTOPCOD,X'89' PRINT AND SKIP TO CHANNEL 1? 02356000 BE RGOCNT YES COUNT IT 02357000 CLI RCTOPCOD,X'8B' IMMED SKIP TO CHANNEL 1? 02358000 BNE RGOFWDLP NO..CONTINUE 02359000 RGOCNT EQU * 02360000 BCT R1,RGOFWDLP REDUCE REC CNT BY 1 AND CONT 02361000 RDGODNE EQU * 02362000 CLI RCTOPCOD,X'8B' IS IT A SKIP IMMED? 02363000 BE RDFWMSG YES..CONTINUE 02364000 MVI RCTOPCOD,X'8B' MAKE IT A SKIP IMMED.. 02365000 MVI RCTTDTA1,C' ' AND ONE CHAR OF DATA 02366000 LA R1,1 ONE BYTE OF DATA 02367000 STH R1,RCTCCWCT AND STORE IN CCW 02368000 RDFWMSG EQU * 02369000 MVC MSGLINK(8),RDRCMDLK MOVE IN RESPONSE LINKID 02370000 MSG 600,AXSFILE WRITE FWD SPAC MSG 02371000 NI RDRCMD,255-RFWDCNT RESET CMD BYTE 02372000 CLI RCTOPCOD,X'8B' IS IT A SKIP IMMED? 02373000 BE RDLOPB YES..CONTINUE 02374000 MVI RCTOPCOD,X'8B' MAKE IT A SKIP IMMED.. 02375000 MVI RCTTDTA1,C' ' AND ONE CHAR OF DATA 02376000 LA R1,1 ONE BYTE OF DATA 02377000 STH R1,RCTCCWCT AND STORE IN CCW 02378000 B RDLOPB AND CONTINUE 02379000 DROP R1 02380000 EJECT 02381000 RDERR1 EQU * 02382000 NI RCTECB,X'FF'-TCTBUSY TURN OFF RDR ECB BUSY @VA10416 02382100 TM RSW1,RACTIV WAS A FILE EVER OPENED? 02383000 BNO RDERR2 NO..EXIT AGAIN 02384000 TM RSW1,RINIT HAS READER BEEN CALLED ONCE? 02385000 BNO RDERR2 NOPE 02386000 MVC RCTTCT1,=F'0' SET END OF FILE INDICATOR 02387000 MVC RCTENTY(2),RACN3 PREPARE FOR REJECT ON SENDING 02388000 RLOC3 EQU * 02389000 LA R8,RCTTANK1 PUT TANK ADDR IN PARAMETER REG 02390000 BAL R14,$TPPUT SEND EOF SIGNAL 02391000 BNZ RDERR2 OPEN WENT OK...CONTINUE 02392000 L R8,RCTCOM GET COMMUTATOR ENTRY 02393000 MVI 1(R8),CLOSE AND CLOSE THE GATE 02394000 MVI RCTWFB,X'FF' SHOW WAITING FOR BUFFER 02395000 B RCTRTN GO WAIT FOR A BUFFER 02396000 SPACE 1 02397000 RDERR2 EQU * 02398000 MVI RCTWFB,X'00' RESET WAITING FOR BUFFERS SW @VA03306 02399000 OI RSW1,RINIT INITIAL CALL OVER 02400000 MVC RCTENTY(2),RACN4 SETUP FOR DELAY 02401000 NI MASTERSW,255-READER INDICATE READER CLOSED 02402000 NI RSW1,255-RACTIV INDICATE NO READER ACTIVE 02403000 L R8,RCTCOM GET COMMUNATOR ENTRY 02404000 MVI 1(R8),CLOSE AND CLOSE THE GATE 02405000 B RCTRTN AND RETURN 02406000 EJECT 02407000 RREOPEN EQU * 02408000 MVI RCTWFB,X'FF' SHOW WAITING FOR BUFFER 02409000 MVC RCTENTY(2),RACN5 SETUP FOR DELAY 02410000 L R8,RCTCOM GET COMMUNTATOR ENTRY 02411000 MVI 1(R8),CLOSE TURN OFF GATE 02412000 B RCTRTN AND EXIT 02413000 SPACE 1 02414000 RLOC5 EQU * 02415000 MVI RCTWFB,X'00' RESET WAITING FOR BUFFER 02416000 B ROPEN GO TRY REOPEN 02417000 SPACE 1 02418000 CLINE EQU X'80' BLOCK PRESENT IN DEBLOCK BUFFER 02419000 RINIT EQU X'40' INITIAL CALL HAS BEEN MADE 02420000 RACTIV EQU X'20' READER ACTIVE 02421000 PTRANS EQU X'10' TRANSMITTING PRINT FILE 02422000 UTRANS EQU X'08' TRANSMITTING PUNCH FILE 02423000 HEADFLAG EQU X'04' TRANSMITTING HEADER 02424000 SPACE 1 02425000 RACN1 DC S(RLOC1) RETURN ENTRY POINT 02426000 RACN2 DC S(RLOC2) RETURN ENTRY POINT 02427000 RACN3 DC S(RLOC3) RETURN ENTRY POINT 02428000 RACN4 DC S(READ1) RETURN ENTRY POINT 02429000 RACN5 DC S(RLOC5) RETURN ENTRY POINT 02430000 EJECT 02431000 *. 02432000 * 02433000 * ENTRY NAME - 02434000 * 02435000 * AXSGET 02436000 * 02437000 * FUNCTION - 02438000 * 02439000 * THIS ROUTINE FUNCTIONS AS THE INTERFACE TO DMTAXS, FOR 02440000 * GETTING FILES TO TRANSMIT, AND PURGE THOSE FILES WHEN 02441000 * TRANSMISSION IS COMPLETE. 02442000 * 02443000 * CALLS TO OTHER ROUTINES - 02444000 * 02445000 * DMTWAT - TO WAIT FOR AN EVENT COMPLETION 02446000 * DMTGIV - TO INITIATE A GIVE REQUEST 02447000 * 02448000 * OPERATION - 02449000 * 02450000 * 1. INITIATE AND WAIT FOR COMPLETION A CALL TO DMTAXS 02451000 * FOR AN INPUT SPOOL FILE TO TRANSMIT. 02452000 * 02453000 * 2. IF FILE OPENED CONSTRUCT HEADER LINE AND SETUP INITIAL 02454000 * PARAMETERS FOR VMDEBLOK 02455000 * 02456000 * 3. IF FILE NOT OPENED RETURN TO CALLER WITH CONDITION CODE SET 02457000 * 02458000 * FOR AN INPUT FILE PURGE: 02459000 * 02460000 * 1. SETUP UP A CALL TO DMTAXS TO CLOSE INPUT FILE. 02461000 * 02462000 * 2. WAIT FOR COMPLETION AND RETURN TO CALLER. 02463000 * 02464000 * RESPONSES - 02465000 * 02466000 * NONE 02467000 * 02468000 * ERROR MESSAGES - 02469000 * 02470000 * NONE 02471000 * 02472000 *. 02473000 SPACE 1 02474000 AXSSAVE DC 16F'0' AXS ROUTINE SAVE AREA 02475000 SPACE 1 02476000 AXSLINK DC CL8' ' REM LOC LINKID TO BE FILLED IN BY IN 02477000 AXSCVD DC D'0' TEMP AREA FOR CVD OPERATIONS 02478000 AXSFILE DC CL4' ' FILE ID 02479000 DC CL4' ' 02480000 AXSRECS DC CL8' ' NUM OF RECORDS 02481000 BLANK DC CL8' ' MSG FILLER 02482000 LOCATION DC CL8' ' LOCAL LOCATION 02483000 SYSTYPE DC CL8' ' REMOTE SYSTEM TYPE @VM01105 02484000 EJECT 02485000 AXSGET DC 0H'0' 02486000 STM R14,R13,AXSSAVE SAVE CALLER'S REGISTER CONTENTS 02487000 MVI RDEVRLEN,X'13' SET REQUEST LENGTH 02488000 MVI RDEVFUN,X'01' SET FUNCTION FOR INPUT OPEN 02489000 MVC RDEVLINK(8),AXSLINK SET LINK ID IN REQUEST 02490000 SR R0,R0 CLEAR R0 TO SIGNAL GIVE INIT REQ 02491000 ST R0,RDEVSYNC CLEAR THE AXS REQUEST SYNCH LOCK TOO 02492000 LA R1,RDEVSYNC R1=ADDR OF THE REQ ELEMENT FOR AXS 02493000 L R15,GIVEREQ R15=ENTRY ADDR FOR SUP GIVE ROUTINE 02494000 BALR R14,R15 MAKE THE REQUEST AVAILABLE TO AXS0 02495000 L R15,WAITREQ R1= ADDR OF ENTRY TO WAIT ROUTINE 02496000 BALR R14,R15 WAIT FOR AXS0 TO PROCESS THE REQUEST 02497000 CLI RDEVSYNC,X'80' WAS THE REQUEST SUCCESSFUL? 02498000 BE AXSGOPEN YEP - GO TRY TO OPEN THE FILE 02499000 TM RDEVSYNC,X'81' FILE ALREADY THERE 02500000 BO AXSGOPEN THATS OKAY TOO 02501000 XC RDEVSYNC(4),RDEVSYNC CLEAR OUT SYNC LOCK 02502000 LM R14,R13,AXSSAVE RESTORE CLOBBERED REGISTERS 02503000 LA R15,4 SET NON ZERO RETURN CODE 02504000 LTR R15,R15 SET CONDITION CODE 02505000 BR R14 RETURN WITH NO BLOCK INDICATION 02506000 SPACE 1 02507000 AXSGOPEN EQU * 02508000 USING SPLINK,R1 GET SPLINK ADDRESSABILITY 02509000 OI RSW1,RACTIV INDICATE FILE OPENED 02510000 L R1,RDEVFIOA GET FILE I/O AREA ADDRESS 02511000 L R8,SPRECNUM PICKUP SPRECNUM FROM NEW BLOCK 02512000 ST R8,VMSPNUM PICKUP COUNT OF REMAINING CCWS 02513000 LA R8,SPRECNUM+4 SETP OVER POINTERS IN SPOOL BLOCK 02514000 ST R8,VMSPANCH TO PICKUP CURRENT CCW ANCHOR 02515000 ST R8,VMSPNEXT CCW POINTER AND NEXT 02516000 OI RSW1,CLINE TO INDICATE BLOCK PRESENT 02517000 TM SMLSYS,MASTER ARE WE IN HOST MODE 02518000 BNO AXSGEXIT NO EXIT 02519000 OI RSW1,HEADFLAG INDICATE TIME TO PRT HEADER 02520000 L R8,RDEVTAG GET TAG ADDR 02521000 CLI TAGINDEV,TYP3210 IS IT SPOOLED CONSOLE OUTPUT? 02522000 BE AXSGLINE YES..TREAT LIKE PRINT 02523000 TM TAGINDEV,TYPPRT IS IT A PRINT FILE? 02524000 BO AXSGLINE YEP - GO GIN UP A REM HEAD LINE 02525000 MVI HDRCHAR,X'5C' INSERT * 02526000 MVC HDRCHAR+1(80-HDRSGLEN-1),HDRCHAR AND PROPAGATE 02527000 B AXSGCOMM AND ENTER COMMON HEAD CODE 02528000 EJECT 02529000 AXSGLINE EQU * 02530000 MVC HDRDIST(8),TAGDIST MOVE IN THE DIST CODE 02531000 MVC HDRNAME(24),TAGNAME AND THE NAME 02532000 MVI HDRCHAR,C' ' INSERT BLANK 02533000 MVC HDRCHAR+1(80-HDRSGLEN-1),HDRCHAR AND PROPAGATE 02534000 AXSGCOMM EQU * 02535000 MVC HDRORGID(8),TAGINLOC MOVE IN THE ORIGIN LOCATION 02536000 MVC HDRVMID(8),TAGINVM AND THE ORIGIN VIRTUAL MACHINE 02537000 MVC HDRTOD(MASKLEN),TODMASK MOVE IN THE EDITING MASK 02538000 LM R0,R1,TAGINTOD R0 AND R1 CONTAIN THE INPUT TOD 02539000 LA R2,HDRTOD R2 CONTAINS THE EBCDIC TOD ADDR 02540000 BAL R14,TODEBCD AND CONVERT 02541000 DROP R1 02542000 SPACE 1 02543000 AXSGEXIT EQU * 02544000 XC RDEVSYNC(4),RDEVSYNC CLEAR OUT SYNC LOCK 02545000 LM R14,R13,AXSSAVE RESTORE ALL REGISTERS 02546000 SR R15,R15 SET ZERO RETURN CODE 02547000 LTR R15,R15 SET CONDITION CODE 02548000 BR R14 AND RETURN TO THE MAIN ROUTINE 02549000 EJECT 02550000 AXSPURGE EQU * 02551000 STM R14,R1,AXSSAVE SAVE CALLER'S REGISTER CONTENTS 02552000 MVI RDEVFUN,X'02' SET PURGE REQUEST CODE FOR AXS1 02553000 SR R0,R0 CLEAR R0 TO SIG GIVE INIT REQ 02554000 ST R0,RDEVSYNC CLEAR THE REQUEST SYNCH LOCK TOO 02555000 LA R1,RDEVSYNC R1=ADDR OF PURGE REQ FOR AXS 02556000 L R15,GIVEREQ R15=ADDR OF ENTRY TO SUP GIVE ROUT 02557000 BALR R14,R15 INITIATE THE REQUEST 02558000 L R15,WAITREQ R15=ADDR OF ENTRY TO SUP WAIT ROUT 02559000 BALR R14,R15 WAIT FOR THE REQUEST TO BE COMPLETED 02560000 XC RDEVSYNC(4),RDEVSYNC CLEAR OUT SYNC LOCK 02561000 XC RDEVSOPT(1),RDEVSOPT CLEAR OUT SUBOPTION FIELD 02562000 LM R14,R1,AXSSAVE RESTORE CLOBBERED REGISTERS 02563000 BR R14 AND RETURN TO THE CALLER 02564000 EJECT 02565000 *. 02566000 * 02567000 * ENTRY NAME - 02568000 * 02569000 * VMDEBLOK 02570000 * 02571000 * FUNCTION - 02572000 * 02573000 * THIS ROUTINE FUNCTIONS AS A DEBLOCK ROUTINE FOR THE 02574000 * VM/370 PAGE SPOOL BUFFERS. IT RETURNS THE DEBLOCKED 02575000 * RECORD IN THE RCTTDTA1 BUFFER. 02576000 * 02577000 * CALLS TO OTHER ROUTINES - 02578000 * 02579000 * DMKDRD - VIA DIAGNONE CODE X'0014' 02580000 * 02581000 * OPERATION - 02582000 * 02583000 * 1. IF NEEDED READ THE NEXT SPOOL PAGE BUFFER FROM VM. 02584000 * 02585000 * 2. CONSTRUCT THE RECORD FROM THE CCW DATA IN THE SPOOL 02586000 * PAGE BUFFER. 02587000 * 02588000 * 3. MOVE IN THE CARRIAGE CONTROL BYTE FROM THE CCW. 02589000 * 02590000 * 4. RETURN TO CALLER. 02591000 * 02592000 * RESPONSES - 02593000 * 02594000 * NONE 02595000 * 02596000 * ERROR MESSAGES - 02597000 * 02598000 * NONE 02599000 * 02600000 *. 02601000 SPACE 1 02602000 * 02603000 * REGISTERS 02604000 * 02605000 * GPR.1 INPUT AREA FOR PACK 02606000 * GPR.2 OUTPUT AREA FOR PACK 02607000 * GPR.3 ANCHOR CCW IN VM SPOOL BLOCK 02608000 * GPR.5 INPUT LENGTH FOR PACK 02609000 * GPR.6 COUNT OF NON-TIC CCWS LEFT IN VM SPOOL BUFFER 02610000 * GPR.7 NEXT CCW IN VM SPOOL BLOCK 02611000 * GPR.9 BASE REGISTER 02612000 * GPR.10 BASE REGISTER 02613000 * GPR.11 BASE REGISTER 02614000 * GPR.12 BASE REGISTER 02615000 * GPR.14 LINK REGISTER 02616000 EJECT 02617000 VMDEBLOK DS 0H 02618000 * 02619000 * SETUP SPOOL BLOCK POINTERS 02620000 * 02621000 STM R0,R15,VMDESAVE SAVE REGISTERS 02622000 * 02623000 * CHECK FOR VM SPOOL BLOCK PRESENT 02624000 * 02625000 TM RSW1,CLINE ANYTHING IN BUFFER? 02626000 BO VMSPBIN IF THE VM SPOOL BLOCK IS IN. 02627000 * 02628000 * READ A VM SPOOL BLOCK. 02629000 * 02630000 VMSPGET EQU * 02631000 * 02632000 USING SPLINK,R5 GET SPLINK ADDRESSABILITY 02633000 L R5,RDEVFIOA GET FILE I/O AREA ADDRESS 02634000 L R8,RDEVTAG GET READER TAG ADDRESS 02635000 LH R6,TAGDEV GET READER ADDRESS 02636000 SR R7,R7 IND READ OF NEXT SP BLK REC 02637000 DIAG R5,R6,X'14' COMMAND SPOOL READER 02638000 * 02639000 BC 8,VMSPOK IF THE READ IS SUCCESSFUL. 02640000 * 02641000 BC 4,VMDERET1 IF END OF FILE. 02642000 BC 2,VMDERET1 IF NO MORE FILES. 02643000 * 02644000 * ERROR ON SPOOL READ, GPR12 WILL CONTAIN.. 02645000 * 4 INVALID SPOOL READER ADDRESS 02646000 * 8 INVALID DEVICE 02647000 * 12 DEVICE BUSY WITH SIO I/O 02648000 * 16 PAGING I/O ERROR IN SETTING UP BUFFER. 02649000 * 02650000 MSG 108,AXSFILE WRITE ERROR MSG 02651000 B VMDERET1 AND IGNORE FOR PRESENT. 02652000 EJECT 02653000 VMSPOK EQU * HERE ON SUCCESSFUL READ 02654000 L R6,SPRECNUM PICKUP SPRECNUM FROM NEW BLOCK. 02655000 LTR R6,R6 ALL DONE IF ZERO 02656000 BZ VMSPGET TO GET THE NEXT SPOOL BLOCK. 02657000 LA R3,SPRECNUM+4 STEP OVER POINTERS IN SPOOL BLOCK 02658000 LR R7,R3 AND INITIALIZE WORKING REGS. 02659000 OI RSW1,CLINE TO INDICATE BLOCK PRESENT 02660000 B VMSPCCW TO PROCESS NEXT CCW CHAIN. 02661000 DROP R5 02662000 SPACE 02663000 * 02664000 * BUFFER IS PRESENT ON ENTRY TO VMSB2CP. 02665000 * 02666000 VMSPBIN EQU * 02667000 L R3,VMSPANCH TO PICKUP CURRENT CCW ANCHOR. 02668000 L R7,VMSPNEXT AND NEXT CCW POINTER. 02669000 L R6,VMSPNUM PICKUP COUNT OF REMAINING CCWS. 02670000 EJECT 02671000 * 02672000 * HERE TO PROCESS NEXT CCW CHAIN. 02673000 * 02674000 VMSPCCW EQU * 02675000 * 02676000 * PRINTER 02677000 * DATA MOVING CCW'S ARE.. 02678000 * (0,1,8,9,A,B,C,D,E)(1,9) 02679000 * PLUS 63 BUT NOT 81 AND E9. 02680000 * PUNCH 02681000 * DATA MOVING CCW'S ARE.. 02682000 * (0,2,4,6,8,A)1 02683000 * 02684000 * READER 02685000 * DATA MOVING CCW'S ARE 02 AND 42 02686000 * THESE ARE PRESENT FOR REAL READER FILES. 02687000 * (AND REQUIRE DIFFERENT TREATMENT THAN VIRTUAL FILES 02688000 * FROM THE PRINTER OR PUNCH.) 02689000 * 02690000 * IMMEDIATE CCW OPS WITH NO DATA ARE.. 02691000 * (0,1,8,9,A,B,C,D,E)(B,3) 02692000 * EXCEPT 03,83, AND EB. 02693000 * 02694000 * 03 IS NOP (USED FOR PASSING SPOOL INFORMATION.) 02695000 * 08 IS TIC TO NEXT CCW CHAIN, IF ANY. 02696000 * 02697000 * AFTER PROCESSING A NON-TIC CCW CC SUCCESSFULLY, BCT TO VMSPRET 02698000 * 02699000 VMSP4 EQU * 02700000 SPACE 2 02701000 * NOP (X'03') IS ASSUMED TO BE A DATA MOVER IF 02702000 * FOLLOWED BY A TIC, OTHERWISE IT IS PROCESSED 02703000 * AS AN IMMEDIATE. 02704000 * 02705000 * 02706000 TM 0(R7),X'06' DECODE CCW 02707000 BZ VMSP1 IF DATA MOVER OR TIC 02708000 CLI 0(R7),X'63' AND 02709000 BE VMSPDATA IF THIS IS A LOAD OF FORMS BUFFER 02710000 CLI 0(R7),X'03' ALSO CHECK FOR A NOP AND 02711000 BE VMSPNOP IF IT IS. 02712000 * 02713000 ***** CHECK FOR REAL READER FILES (42,02) IGNORE FOR MOMENT ****** 02714000 * 02715000 CLI 0(R7),X'42' REAL READER CCW? 02716000 BE VMSPFINI YES 02717000 CLI 0(R7),X'02' REAL READER CCW? 02718000 BE VMSPFINI YES 02719000 EJECT 02720000 * NOT DATA MOVER, TIC, OR END. IMMEDIATE IS ASSUMED. 02721000 * 02722000 VMSPIMED EQU * 02723000 MVC RCTOPCOD(1),0(R7) SET OP CODE 02724000 LA R4,1 SET DATA LENGTH TO 1 02725000 STH R4,RCTCCWCT AND STORE IN TCT 02726000 MVI RCTTDTA1,X'40' ONE BYTE OF DATA 02727000 * 02728000 * HERE IF NON-TIC 02729000 * 02730000 VMSP2 EQU * 02731000 LA R7,8(,R7) STEP TO NEXT CCW AND 02732000 CLI 0(R7),X'08' CHECK IF TIC 02733000 BE VMSP3 IF IT IS, ELSE 02734000 LR R3,R7 MOVE ANCHOR ALSO. THEN 02735000 VMSP3 EQU * 02736000 BCT R6,VMSPRET TO PROCESS NEXT, IF ANY 02737000 B VMSPFINI THAT'S ALL FOLKS. 02738000 * 02739000 * HERE IF CCW IS XXXXX00X (BASE 2) 02740000 * 02741000 VMSP1 EQU * 02742000 TM 0(R7),X'01' CONTINUE DECODE 02743000 BO VMSPDATA IF CCW IS XXXXX001 02744000 CLI 0(R7),X'08' CHECK DIRECTLY FOR TIC 02745000 BE VMSPTIC IF YES. 02746000 SPACE 2 02747000 MSG 190,AXSFILE WRITE THE MSG 02748000 B VMSPFINI TO IGNORE FOR PRESENT. 02749000 SPACE 3 02750000 VMSPTIC EQU * PROCESS TIC. 02751000 LH R7,2(R7) GET DISPLACEMENT OF NEXT CCW AND 02752000 AR R3,R7 ADD IN LAST ANCHOR TO GET NEW ONE. 02753000 LR R7,R3 TO INDICATE NEXT CCW TO BE PROCESSED 02754000 B VMSPCCW TO PROCESS IT. 02755000 SPACE 3 02756000 VMSPNOP EQU * PROCESS NOP 02757000 CLI 8(R7),X'08' LOOK AHEAD FOR TIC AND 02758000 BE VMSPDATA TREAT A DATA MOVER IF PRESENT. 02759000 B VMSPIMED ELSE TREAT AS IMMEDIATE. 02760000 EJECT 02761000 VMSPDATA EQU * HERE FOR DATA MOVING CCW CC. 02762000 MVI RCTTDTA1,X'40' BLANK FIRST BYTE OF OUTPUT 02763000 MVC RCTTDTA1+1(131),RCTTDTA1 AND BLANK THE REST OF BUFFER 02764000 LH R1,2(R7) GET OFFSET FROM ANCHOR FOR DATA 02765000 AR R1,R3 AND MAKE IT ABSOLUTE 02766000 SR R5,R5 CLEAR OUT REGISTER 02767000 IC R5,7(R7) PICKUP COUNT OF DATA 02768000 MVC RCTOPCOD(1),0(R7) MOVE IN CCW CC, THEN 02769000 STH R5,RCTCCWCT SET DATA LENGTH IN TCT 02770000 BCTR R5,0 REDUCE BY ONE FOR CHARACTER @VA05472 02771000 * OPERATION 02772000 EX R5,VMDEMVC MOVE IN PACKED DATA. 02773000 B VMSP2 AND RETURN 02774000 SPACE 3 02775000 VMSPFINI EQU * DONE WITH A VM SPOOL BLOCK 02776000 NI RSW1,X'FF'-CLINE TO TURN OFF BLOCK FLAG AND 02777000 SPACE 3 02778000 VMSPRET EQU * 02779000 ST R3,VMSPANCH SAVE CCW ANCHOR. 02780000 ST R7,VMSPNEXT AND NEXT CCW 02781000 ST R6,VMSPNUM AND COUNT OF REMAINING CCW'S. 02782000 SR R15,R15 SET 0 RET CODE 02783000 B VMDERET2 TO COMPLETE RETURN. 02784000 SPACE 1 02785000 VMDERET1 EQU * 02786000 LA R15,4 SET NON ZERO RETURN CODE 02787000 SPACE 1 02788000 VMDERET2 EQU * 02789000 LM R0,R14,VMDESAVE RESTORE CALLERS REGS 02790000 LTR R15,R15 SET CONDITION CODE ON RETURN 02791000 BR R14 AND RETURN 02792000 SPACE 3 02793000 VMDEMVC MVC RCTTDTA1(0),0(R1) TO BE EXECUTED BY ABOVE CODE 02794000 SPACE 1 02795000 * TEMPORARIES 02796000 * 02797000 VMSPANCH DS F CCW ANCHOR 02798000 VMSPNEXT DS F NEXT CCW 02799000 VMSPNUM DS F NUMBER OF DATA RECORDS IN 4K BUFFER 02800000 VMDESAVE DS 16F REGISTER SAVE AREA 02801000 EJECT 02802000 *. 02803000 * 02804000 * ENTRY NAME - 02805000 * 02806000 * HEADPREP 02807000 * 02808000 * FUNCTION - 02809000 * 02810000 * THIS ROUTINE PROVIDES, ONE RECORD AFTER THE OTHER, 02811000 * THE SEPARATOR AND THE HEADER FOR THE PRINT TYPE FILES 02812000 * AND THE HEADER CARD FOR THE PUNCH TYPE FILES. 02813000 * 02814000 * CALLS TO OTHER ROUTINES - 02815000 * 02816000 * 02817000 * 02818000 * OPERATION - 02819000 * 02820000 * 1. GET NEXT ENTRY FROM HEADER TABLE AND PLACE IN THE OUTPUT 02821000 * BUFFER. 02822000 * 02823000 * 2. UPDATE HEADER TABLE TO NEXT ENTRY. 02824000 * 02825000 * 3. IF AT END OF TABLE RESET TABLE AND HEADFLAG. 02826000 * 02827000 * ENTRY CONDITIONS: 02828000 * 02829000 * IN REG. 14 THE RETURN ADDRESS. 02830000 * 02831000 * EXIT CONDITIONS: 02832000 * 02833000 * THE INTERMEDIATE BUFFER BUFUNPK, CONTAINS THE ACTUAL 02834000 * SEPARATOR OR HEADER RECORD. 02835000 EJECT 02836000 * 02837000 * NOTE: 02838000 * 02839000 * THE SEPARATOR FOR THE PRINT TYPE FILES IS AS FOLLOWS: 02840000 * 02841000 * PAGE EJECT 02842000 * SKIP 61 LINES 02843000 * 5 LINES OF 130 ASTERISKS 02844000 * 1 LINE OF 130 UNDERLINES 02845000 * 5 LINES OF 130 ASTERISKS 02846000 * 2 BLANK LINES 02847000 * 02848000 * THE HEADER FOR BOTH THE PRINT AND PUNCH TYPE FILES, 02849000 * IS AS FOLLOWS: 02850000 * 02851000 * 1- 8 FILE ORIGIN LOCATION 02852000 * 13-20 FILE ORIGIN VIRTUAL MACHINE 02853000 * 25-32 FILE ORIGIN DATE 02854000 * 37-44 FILE ORIGIN TIME 02855000 * 55-68 WAS THE ORIGIN 02856000 * 02857000 * 02858000 * RESPONSES - 02859000 * 02860000 * NONE 02861000 * 02862000 * ERROR MESSAGES - 02863000 * 02864000 * NONE 02865000 * 02866000 *. 02867000 SPACE 3 02868000 HEADPREP EQU * 02869000 STM R13,R15,HDPRSAVE SAVE CALLER REGISTERS 02870000 TM RSW1,PTRANS PRINT FILE? 02871000 BZ HEADLINE NO - ONLY HEADER CARD 02872000 L R13,HEADPNT LOAD THE HEADER POINTER 02873000 L R14,0(R13) GET THE ADDRESS 02874000 BR R14 AND GO TO EXEC IT 02875000 SPACE 2 02876000 SKIPCH1 EQU * 02877000 MVI RCTOPCOD,X'88' SKIP TO CHA. 1 02878000 MVI RCTTDTA1,X'40' ONE BYTE OF DATA 02879000 B HEADRET0 AND GO TO EXIT 02880000 SPACE 02881000 SKIP3 EQU * 02882000 MVI RCTOPCOD,X'19' SKIP THREE LINES 02883000 MVI RCTTDTA1,X'40' ONE BYTE OF DATA 02884000 B HEADRET0 AND CONTINUE 02885000 EJECT 02886000 DOUBSP EQU * 02887000 MVI RCTOPCOD,X'13' DOUBLE SPACE 02888000 MVI RCTTDTA1,X'40' ONE BYTE OF DATA 02889000 HEADRET0 EQU * 02890000 LA R15,1 GET DATA COUNT 02891000 STH R15,RCTCCWCT AND STORE IN CCW 02892000 B HEADRET 02893000 SPACE 02894000 ASTER EQU * 02895000 MVI RCTTDTA1,X'5C' * 02896000 B ASTUND AND CONTINUE 02897000 SPACE 1 02898000 UNDERLIN EQU * 02899000 MVI RCTTDTA1,X'6D' _ 02900000 SPACE 02901000 ASTUND EQU * 02902000 MVI RCTOPCOD,X'09' PRINT AND SPACE 1 02903000 MVC RCTTDTA1+1(130),RCTTDTA1 **** OR ---- @VA09561 02904010 LA R15,131 SET LENGTH 02905000 STH R15,RCTCCWCT AND STORE IN CCW 02906000 B HEADRET AND RETURN 02907000 SPACE 02908000 HEAD2LIN EQU * 02909000 LA R14,HDRLINE2 GET SECOND HEAD LINE ADDR 02910000 LA R15,LHDRLIN2 AND THE LENGTH 02911000 B HEADCONT AND CONTINUE 02912000 SPACE 02913000 HEADLINE EQU * 02914000 LA R14,HDRLINE GET THE FIRST HEADER LINE ADDR 02915000 LA R15,HDRLEN HEADER LENGTH 02916000 HEADCONT EQU * 02917000 MVI RCTOPCOD,X'19' MOVE IN OPCODE 02918000 BCTR R15,0 MINUS 1 02919000 EX R15,MVCHEAD MOVE THE LINE 02920000 LA R15,1(,R15) RESTORE THE BYTES COUNT 02921000 STH R15,RCTCCWCT STORE COUND IN CCW 02922000 EJECT 02923000 HEADRET EQU * 02924000 TM RSW1,PTRANS PRINT FILE? 02925000 BNO HEADRST NO - EXIT 02926000 CLC HEADCRNT(1),0(R13) ENOUGH OF THIS TYPE? 02927000 BE HEADNEXT YES 02928000 SR R14,R14 CLEAR FOR IC 02929000 IC R14,HEADCRNT GET CURRENT NUM OF THIS TYPE 02930000 LA R14,1(,R14) AND UP BY 1 02931000 STC R14,HEADCRNT AND UPDATE THE NUM 02932000 B HEADRET1 AND CONTINUE 02933000 SPACE 1 02934000 HEADNEXT EQU * 02935000 MVI HEADCRNT,X'01' START OVER 02936000 LA R13,4(,R13) UPDATE POINTER FOR TABLE 02937000 CLI 0(R13),X'FF' END OF TABLE? 02938000 BNE HEADRET1 NO CONTINUE 02939000 HEADRST EQU * 02940000 LA R13,HEADTABL RESET TABLE POINTER 02941000 NI RSW1,X'FF'-HEADFLAG RESET HEADER FLAG 02942000 SPACE 02943000 HEADRET1 EQU * 02944000 ST R13,HEADPNT SAVE POINTER 02945000 LM R13,R15,HDPRSAVE RESTORE CALLER REGISTERS 02946000 BR R14 AND RETURN 02947000 SPACE 3 02948000 MVCHEAD MVC RCTTDTA1(*-*),0(R14) TO BE EXECUTED FROM ABOVE 02949000 SPACE 02950000 HDPRSAVE DS 3F SAVE AREA 02951000 HEADPNT DC AL4(HEADTABL) CURRENT POSITION OF HEAD TABLE 02952000 HEADCRNT DC X'01' CURRENT NUM OF THIS LINE 02953000 SPACE 02954000 HEADTABL DS 0F 02955000 DC AL1(1),AL3(SKIPCH1) SKIP TO CH. 1 02956000 DC AL1(16),AL3(SKIP3) SKIP THREE LINES 02957000 DC AL1(5),AL3(DOUBSP) SKIP TWO LINES 02958000 DC AL1(5),AL3(ASTER) 130 * 02959000 DC AL1(1),AL3(UNDERLIN) 130 _ 02960000 DC AL1(5),AL3(ASTER) 130 * 02961000 DC AL1(1),AL3(DOUBSP) DOUBLE SPACE 02962000 DC AL1(1),AL3(HEADLINE) HEADER LINE 02963000 DC AL1(1),AL3(HEAD2LIN) HEADER LINE 02964000 DC XL4'FFFFFFFF' END OF TABLE 02965000 EJECT 02966000 HDRLINE EQU * PRINT LINE AND SPACE THREE COMMAND 02967000 HDRSGTOP EQU * 02968000 HDRORGID DC 8C'Y' FILE ORIGIN LOC ID TO BE FILLED IN 02969000 DC 4C' ' FOUR BLANKS 02970000 HDRVMID DC 8C'X' FILE ORIGIN VM ID TO BE FILLED IN 02971000 DC 3C' ' THREE MORE BLANKS 02972000 HDRTOD DC C' ' BEGINNING OF FIELD TO BE EDITED 02973000 DC C'XX/XX/XX' FILE ORIGIN DATE FROM TOD ROUTINE 02974000 DC 4C' ' FOUR MORE BLANKS 02975000 DC C'YY:YY:YY' FILE ORIGIN TIME FROM TOD ROUTINE 02976000 DC 2C' ' TWO MORE BLANKS 02977000 DC 6C' ' SIX MORE BLANKS @VA03113 02978000 DC C' WAS THE ORIGIN' ENDING NOTE 02979000 HDRSGLEN EQU (*-HDRSGTOP) END OF THE SEGMENT DATA FIELD 02980000 HDRCHAR DC (80-HDRSGLEN)C' ' 02981000 HDRLEN EQU (*-HDRLINE) END OF HEADER LINE RECORD 02982000 SPACE 02983000 TODMASK DC AL1(MASKLEN-1) LENGTH OF REMAINING MASK FIELD 02984000 DC X'2120',C'/',X'2020',C'/',X'2020' DATE MASK 02985000 DC 3C' ' THREE BLANKS 02986000 DC X'22' RESET SIGNIFICANCE INDICATOR 02987000 DC X'2120',C':',X'2020',C':',X'2020' TIME MASK 02988000 DC 2C' ' 2 BLANKS TO SEP ENDING NOTE @VA03113 02989000 MASKLEN EQU (*-TODMASK) END OF EDIT MASK 02990000 SPACE 2 02991000 HDRLINE2 EQU * START OF SECOND HEADER LINE 02992000 DC C'DEST: ' 02993000 HDRLINK DC CL8' ' LINK ID 02994000 DC C' FILE: ' 02995000 HDRFILE DC CL4' ' SPOOL FILE ID 02996000 DC C' NAME: ' 02997000 HDRNAME DC CL24' ' FILE NAME AND TYPE 02998000 DC C' DIST: ' 02999000 HDRDIST DC CL8' ' DISTRIBUTION CODE 03000000 DC C' RECS: ' 03001000 HDRRECS DC CL8' ' NUMBER OF RECORDS 03002000 LHDRLIN2 EQU *-HDRLINE2 LENGTH OF SECOND HDR LINE 03003000 EJECT 03004000 *. 03005000 * 03006000 * ENTRY NAME - 03007000 * 03008000 * TODEBCD 03009000 * 03010000 * FUNCTION - 03011000 * 03012000 * CONVERT S/370 TOD TO EBCDIC DATE AND TIME 03013000 * 03014000 * CALLS TO OTHER ROUTINES - 03015000 * 03016000 * GTODEBC - TO CONVERT THE TIME AND DATE 03017000 * 03018000 * OPERATION - 03019000 * 03020000 * 1. ISSUE A CALL TO COMMON GTODEBCD ROUTINE TO 03021000 * RETRIEVE TIME AND DATE. 03022000 * 03023000 * RESPONSES - 03024000 * 03025000 * NONE 03026000 * 03027000 * ERROR MESSAGES - 03028000 * 03029000 * NONE 03030000 * 03031000 *. 03032000 SPACE 3 03033000 TODEBCD DC 0H'0' 03034000 STM R13,R14,TODSAVE1 SAVE RETURN 03035000 LA R13,MMDDYYHH GET WORK ADDR ADDR FOR CALL 03036000 L R15,TCOM GET COMMON ROUTINE ADDR 03037000 L R15,GTODEBCD AND THE TIME CONVERT ADDR 03038000 BALR R14,R15 AND DO IT 03039000 LM R13,R14,TODSAVE1 RESTORE REGS 03040000 BR R14 AND RETURN 03041000 SPACE 03042000 MMDDYYHH DC D'0' TO HOLD NEW HOUR CALCULATION IN DEC 03043000 DC D'0' FOR APPENDING MMDDYYHH TO MMSSMMMM 03044000 MMSSMMMM DC D'0' TO RECEIVE DECIMAL MINUTE AND SECOND 03045000 DAYNUMBR DC A(0) TO RECEIVE COMPUTED DAY OF WEEK 0->6 03046000 TODEBCON DC F'-1',A(0+4,TIMEZON+4) SEE BELOW 03047000 * DC F'-1' TO HOLD LAST CALCULATION ELAPSED HOURS 03048000 * DC A(0+4) SWITCH, USED AS AN INDEX, FOR STD VS. DLT TIME 03049000 * DC A(TIMEZON+4) EXTERNAL ADDRESS OF TIMEZONE DISP TABLE 03050000 TODSAVE DC 11F'0' TODEBCD ROUTINE SAVE AREA 03051000 SPACE 03052000 TODSAVE1 DC 2F'0' SAVE AREA 03053000 SPACE 03054000 TIMEZON DC Y(0),CL6' ' DONT CONVERT TIME ZONE @VA03113 03055000 DC Y(0),CL6' ' ITS CORRECT AS IT IS @VA03113 03056000 EJECT 03057000 *. 03058000 * 03059000 * ENTRY NAME - 03060000 * 03061000 * $WRTN1 03062000 * 03063000 * FUNCTION - 03064000 * 03065000 * THIS ROUTINE WILL WRITE RECEIVED MSGS TO THE RSCS 03066000 * OPERATOR IF RJE MODE OR PASS COMMANDS TO DMTREX FOR 03067000 * EXECUTION IF OPERATING IN HOST MODE. THESE COMMANDS OR 03068000 * MESSAGES ARE DEQUEUED FROM THE CONSOLE TCT. 03069000 * 03070000 * CALLS TO OTHER ROUTINES - 03071000 * 03072000 * DMTWAT - TO WAIT FOR AN EVENT COMPLETION 03073000 * DMTGIV - TO INITIATE A GIVE REQUEST 03074000 * 03075000 * OPERATION - 03076000 * 03077000 * 1. GET A RECEIVED TANK VIA CALL TO $GETTNK 03078000 * 03079000 * 2. IF HOST MODE TREAT LIKE COMMAND AND PASS TO DMTREX 03080000 * FOR EXECUTION. 03081000 * 03082000 * 3. IF RJE MODE TREAT LIKE MSG AND WRITE MSG 170. 03083000 * 03084000 * 4. FREE THE TANK AND EXIT TO COMMUTATOR. 03085000 * 03086000 * RESPONSES - 03087000 * 03088000 * DMTSML170I FROM 'LINKID': (MSG TEXT) 03089000 * 03090000 * ERROR MESSAGES - 03091000 * 03092000 * NONE 03093000 * 03094000 *. 03095000 SPACE 3 03096000 USING TANKDSEC,R8 GET TANK ADDRESSABILITY 03097000 $WRTN1 DS 0H 03098000 WINIT DS 0H CONSOLE LOOP ENTRY POINT 03099000 MVI $WCOMM1+1,CLOSE CLOSE THE GATE 03100000 WTANKTST EQU * 03101000 CLI WCTTNKCT,0 TEST FOR TANK 03102000 BNE WGETTANK IF WE HAVE ONE GET IT 03103000 MVC WCTENTY(2),WACN1 SET UP FOR WAIT 03104000 B WCTRTN AND EXIT 03105000 EJECT 03106000 WGETTANK EQU * 03107000 BAL R14,$GETTNK WAIT FOR THE NEXT TANK 03108000 LH R6,TANKCNT GET DATA COUNT 03109000 TM SMLSYS,MASTER IS IT HOST MODE 03110000 BNO WGET2 NO TREAT LIKE MSG 03111000 WGET1 EQU * 03112000 LTR R1,R6 SAVE FOR MSG PROCESSOR 03113000 BZ WGET1A NULL CMD 03114000 BCTR R6,0 REDUCE BY 1 FOR EXECUTE 03115000 EX R6,WTOMOV MOVE INTO OUTPUT BUFFER 03116000 WGET1A EQU * 03117000 AH R1,=H'3' INCLUDE THE HEADER 03118000 STC R1,WTOMBUF AND STORE IN GIVE REQUEST BUF 03119000 XC WTOMCMD(4),WTOMCMD CLEAR OUT SYNCH LOCK 03120000 OC WTOBUF(120),WTORJBUF TRANSLATE TO UPPER CASE 03121000 LA R1,WTOMCMD GET BUFFER ADDR 03122000 L R15,GIVEREQ GET GIVE REQUEST PROCESSOR 03123000 BALR R14,R15 AND EXECUTE IT 03124000 L R15,WAITREQ SYSTEM WAIT PROCESSOR 03125000 BALR R14,R15 GO WAIT 03126000 B WGETRET AND RETURN 03127000 SPACE 1 03128000 WGET2 EQU * 03129000 CH R6,=H'104' MSG LONGER THAN 104? @VA03305 03130000 BNH *+8 NO, OK @VA03305 03131000 LA R6,104 MAKE LENGTH A MAX OF 104 @VA03305 03132000 MVC WTORJMSG+4(8),AXSLINK MOVE IN THE LINKID TO MSG 03133000 LR R1,R6 SAVE FOR LATER 03134000 BCTR R6,0 REDUCE BY ONE FOR MVC 03135000 EX R6,WTOMOV1 EXECUTE THE MOVE 03136000 LA R1,7(R1) ROUND UP TO EVEN 03137000 SRL R1,3 8 BYTE 03138000 SLL R1,3 BOUNDARY 03139000 AH R1,=H'12' UP FOR HEADER 03140000 LR R0,R1 MOVE INTO R1 03141000 LA R1,WTORJMSG GET MSG ADDR 03142000 MVI MSGBLK+2,X'80' INDICATE TO RSCS CONSOLE ONLY 03143000 BAL R14,MSG AND WRITE THE MSG 03144000 MVI WTORJBUF,C' ' BLANK FIRST BYTE 03145000 MVC WTORJBUF+1(119),WTORJBUF AND THE REST 03146000 WGETRET EQU * 03147000 MVC 0(4,R8),$TANKPOL GET FIRST FREE OFF QUEUE 03148000 ST R8,$TANKPOL MAKE THIS ONE THE FIRST 03149000 MVI $TPGETCM+1,OPEN OPEN TPGET GATE 03150000 B WINIT GET THE NEXT LINE FOR OUTPUT 03151000 EJECT 03152000 WTOMOV MVC WTOBUF(0),TANKDATA TO BE EXECUTED BY ABOVE CODE 03153000 WTOMOV1 MVC WTORJBUF(0),TANKDATA TO BE EXECUTED BY ABOVE CODE 03154000 SPACE 1 03155000 WTOMCMD DC F'0' SYNCH LOCK 03156000 DC CL4'REX ' COMMAND EXECUTATOR 03157000 DC A(WTOMBUF) REQUEST BUFFER 03158000 DC A(0) NO RESPONSE REQUESTED 03159000 SPACE 1 03160000 WTOMBUF DC AL1(0),X'00',AL2(0) LENGTH,FUNCTION,ZERO 03161000 WTOBUF DC CL120' ' CONSOLE OUTPUT BUFFER 03162000 SPACE 1 03163000 WTORJMSG DC AL2(170),AL2(0) NUMBER PLUS SPARE 03164000 DC CL8' ' LINKID 03165000 WTORJBUF DC CL120' ' MSG BUFFER 03166000 WACN1 DC S(WINIT) RETURN ENTRY POINT 03167000 EJECT 03168000 *. 03169000 * 03170000 * ENTRY NAME - 03171000 * 03172000 * CMDPROC 03173000 * 03174000 * FUNCTION - 03175000 * 03176000 * THIS ROUTINE EXECUTES COMMANDS PASSED TO IT IN THE 03177000 * CMDRESP BUFFER AFTER AN ALERT FROM DMTREX INDICATING A 03178000 * CMD HAS BEEN ENTERED. 03179000 * 03180000 * CALLS TO OTHER ROUTINES - 03181000 * 03182000 * NONE 03183000 * 03184000 * OPERATION - 03185000 * 03186000 * 1. SCAN COMMAND TABLE FOR MATCH. 03187000 * 03188000 * 2. IF FOUND BRANCH TO APPROPRIATE SUBROUTINE TO PROCESS 03189000 * COMMAND. 03190000 * 03191000 * 3. UPON RETURN RESET COMMAND IN PROGRESS SWITCH AND RETURN. 03192000 * 03193000 * RESPONSES - 03194000 * 03195000 * SEE EACH SUBROUTINE 03196000 * 03197000 * ERROR MESSAGES - 03198000 * 03199000 * SEE EACH SUBROUTINE 03200000 * 03201000 *. 03202000 SPACE 3 03203000 DS 0H 03204000 CMDPROC EQU * 03205000 MVI $CMDCOM+1,CLOSE CLOSE GATE 03206000 LM R3,R5,CMDSETUP PREPARE FOR COMMAND SCAN 03207000 CMDSCAN EQU * 03208000 CLC 0(1,R3),CMDRESP+1 IS IT THIS ONE 03209000 BE CMDCALL YES 03210000 BXLE R3,R4,CMDSCAN PREPARE FOR NEXT COMPARE 03211000 B CMDRET IGNORE IF NOT FOUND 03212000 SPACE 03213000 CMDCALL EQU * 03214000 L R6,SMLLINK GET LINK TABLE ADDR 03215000 MVC MSGLINK(8),CMDRESP+4 MOVE IN RESPONSE LINKID 03216000 L R15,0(R3) GET ROUTINE TO CALL 03217000 BALR R14,R15 GO EXECUTE THE COMMAND 03218000 CMDRET EQU * 03219000 MVI CMDINPGS,X'00' RESET COMMAND IN PROGRESS SWITCH 03220000 B $CMDCOM+4 AND EXIT 03221000 EJECT 03222000 *---------------------------------------------------------------------* 03223000 * START COMMAND * 03224000 *---------------------------------------------------------------------* 03225000 *. 03226000 * RESPONSES - 03227000 * 03228000 * DMTSML752I LINK 'LINKID' STILL ACTIVE -- DRAIN STATUS 03229000 * RESET 03230000 * 03231000 * ERROR MESSAGES - 03232000 * 03233000 * DMTSML750E LINK 'LINKID' ALREADY ACTIVE -- NO ACTION TAKEN 03234000 * 03235000 *. 03236000 SPACE 1 03237000 SETSTART EQU * 03238000 ST R14,CMDCMDSV SAVE RETURN REG 03239000 TM LFLAG,LDRAIN ARE WE DRAINING? 03240000 BNO SETSTRT1 NO 03241000 NI LFLAG,255-LDRAIN RESET DRAIN FLAG 03242000 MSG 752,AXSLINK AND WRITE MSG 03243000 B SETSTRTE AND EXIT 03244000 SPACE 1 03245000 SETSTRT1 EQU * 03246000 CLI CMDRESP+3,STACLASS CLASS RESET? 03247000 BE SETSTRTE YES..NO MSG 03248000 MSG 750,AXSLINK WRITE MSG 03249000 SETSTRTE EQU * 03250000 TM SMLSYS,SGNONREC READY TO GO? @VA09761 03251100 BM SETSTAE2 NO ..EXIT 03252000 TM MASTERSW,READER READER ALREADY ACTIVE? 03253000 BO SETSTAE2 YES..CONTINUE 03254000 OI $RCOMM1+1,OPEN OPEN READER GATE 03255000 SETSTAE2 EQU * 03256000 L R14,CMDCMDSV RESTORE RETURN REG 03257000 BR R14 AND RETURN 03258000 EJECT 03259000 *---------------------------------------------------------------------* 03260000 * DRAIN COMMAND * 03261000 *---------------------------------------------------------------------* 03262000 *. 03263000 * RESPONSES - 03264000 * 03265000 * DMTSML570I LINK 'LINKID' NOW SET TO DEACTIVATE 03266000 * 03267000 * ERROR MESSAGES - 03268000 * 03269000 * DMTSML571E LINK 'LINKID' ALREADY SET TO DEACTIVATE 03270000 * 03271000 *. 03272000 SPACE 1 03273000 SETDRAIN EQU * 03274000 ST R14,CMDCMDSV SAVE RETURN 03275000 TM LFLAG,LDRAIN ALREADY DRAINING? 03276000 BO SETDRER1 YES ..ERROR 03277000 OI LFLAG,LDRAIN SHOW WE ARE DRAINING 03278000 MSG 570,AXSLINK WRITE MSG 03279000 CLI MASTERSW,X'00' COULD WE ALREADY BE DRAINED? 03280000 BE EOJ IF SO..ALL DONE..WITH EASE 03281000 B SETDRXIT IF NOT EXIT 03282000 SPACE 03283000 SETDRER1 EQU * 03284000 MSG 571,AXSLINK WRITE ERROR MSG 03285000 SETDRXIT EQU * 03286000 L R14,CMDCMDSV RESTORE RETURN REG 03287000 BR R14 AND RETURN 03288000 EJECT 03289000 *---------------------------------------------------------------------* 03290000 * FREE COMMAND * 03291000 *---------------------------------------------------------------------* 03292000 *. 03293000 * RESPONSES - 03294000 * 03295000 * DMTSML590I LINK 'LINKID' RESUMING FILE TRANSFER 03296000 * 03297000 * ERROR MESSAGES - 03298000 * 03299000 * DMTSML591E LINK 'LINKID' NOT IN HOLD STATUS 03300000 * 03301000 *. 03302000 SPACE 1 03303000 SETFREE EQU * 03304000 ST R14,CMDCMDSV SAVE RETURN 03305000 TM LFLAG,LHOLD ARE WE HELD? 03306000 BNO SETFRER1 NO ERROR 03307000 MSG 590,AXSLINK WRITE FREE MSG 03308000 NI LFLAG,255-LHOLD TURN OFF HOLD FLAG 03309000 TM RDRCMD,RHLDIPGS WAS THE HOLD IMMED? 03310000 BO SETFRXIT YES..ALL DONE 03311000 TM SMLSYS,MASTER+SGNONREC DID WE SIGNON 03312000 BZ SETFRXIT NO - EXIT @VA03110 03313000 OI $RCOMM1+1,OPEN MUST TRY TO GET FILE 03314000 B SETFRXIT AND ENTER COMMON EXIT 03315000 SPACE 1 03316000 SETFRER1 EQU * 03317000 MSG 591,AXSLINK NOT IN HOLD MSG 03318000 SETFRXIT EQU * 03319000 NI RDRCMD,255-RHLDIPGS TURN OFF FLAG 03320000 L R14,CMDCMDSV RESTORE RETURN 03321000 BR R14 AND RETURN 03322000 EJECT 03323000 *---------------------------------------------------------------------* 03324000 * HOLD COMMAND * 03325000 *---------------------------------------------------------------------* 03326000 *. 03327000 * RESPONSES - 03328000 * 03329000 * DMTSML610I LINK 'LINKID' TO SUSPEND FILE TRANSMISSION 03330000 * DMTSML611I LINK 'LINKID' FILE TRANSMISSION SUSPENDED 03331000 * 03332000 * ERROR MESSAGES - 03333000 * 03334000 * DMTSML612E LINK 'LINKID' ALREADY IN HOLD STATUS 03335000 * 03336000 *. 03337000 SPACE 1 03338000 SETHOLD EQU * 03339000 ST R14,CMDCMDSV SAVE RETURN 03340000 TM LFLAG,LHOLD ALREADY IN HOLD? 03341000 BO SETHLDE1 YES ERROR 03342000 TM CMDRESP+3,HOLDIMM HOLD IMMEDIATE? 03343000 BO SETHLDIM YES PROCESS IT 03344000 OI RDRCMD,RHLDIPGS MARK HOLD IN PROGRESS 03345000 MSG 610,AXSLINK WRITE SET TO HOLD MSG 03346000 B SETHLDXT AND ENTER COMMON EXIT 03347000 SPACE 1 03348000 SETHLDIM EQU * 03349000 OI LFLAG,LHOLD HOLD IT REGARDLESS 03350000 MSG 611,AXSLINK WRITE HELD MSG 03351000 B SETHLDXT AND ENTER COMMON EXIT 03352000 EJECT 03353000 SETHLDE1 EQU * 03354000 MSG 612,AXSLINK WRITE ALREADY HELD MSG 03355000 SETHLDXT EQU * 03356000 MVC HLDCMDLK(8),CMDRESP+4 SAVE RESPONSE LINK FOR LATER 03357000 L R14,CMDCMDSV RESTORE RETURN 03358000 BR R14 AND RETURN 03359000 EJECT 03360000 *---------------------------------------------------------------------* 03361000 * TRACE COMMAND * 03362000 *---------------------------------------------------------------------* 03363000 *. 03364000 * RESPONSES - 03365000 * 03366000 * DMTSML801I LINK 'LINKID' ERROR TRACE STARTED 03367000 * DMTSML802I LINK 'LINKID' TRACE STARTED 03368000 * DMTSML803I LINK 'LINKID' TRACE ENDED 03369000 * 03370000 * ERROR MESSAGES - 03371000 * 03372000 * DMTSML810E LINK 'LINKID' TRACE ALREADY ACTIVE 03373000 * DMTSML811E LINK 'LINKID' TRACE NOT ACTIVE 03374000 * 03375000 *. 03376000 SPACE 1 03377000 SETTRACE EQU * 03378000 ST R14,CMDCMDSV SAVE RETURN REGISTER 03379000 CLI CMDRESP+3,TRACEOFF TRACE OFF? 03380000 BNE SETTR1 NO CONTINUE 03381000 TM LFLAG,LTRALL+LTRERR ARE WE TRACING AT ALL? 03382000 BZ SETTRE2 NO ERROR 03383000 NI LFLAG,255-LTRALL-LTRERR TURN OFF TR BITS 03384000 MSG 803,AXSLINK WRITE THE MSG 03385000 B SETTRXIT AND EXIT 03386000 SPACE 03387000 SETTR1 EQU * 03388000 TM LFLAG,LTRALL+LTRERR ARE WE TRACING ALREADY? 03389000 BM SETTRE1 YES ERROR 03390000 CLI CMDRESP+3,TRACERR ERROR TRACING? 03391000 BNE SETTR2 NO ERROR 03392000 OI LFLAG,LTRERR SET ERROR TRACE ON 03393000 MSG 801,AXSLINK WRITE MSG 03394000 B SETTRXIT AND EXIT 03395000 EJECT 03396000 SETTR2 EQU * 03397000 OI LFLAG,LTRALL SET TRACE ALL 03398000 MSG 802,AXSLINK AND WRITE MSG 03399000 B SETTRXIT AND EXIT 03400000 SPACE 03401000 SETTRE1 EQU * 03402000 MSG 810,AXSLINK AND WRITE THE MSG 03403000 B SETTRXIT AND EXIT 03404000 SPACE 03405000 SETTRE2 EQU * 03406000 MSG 811,AXSLINK AND WRITE MSG 03407000 SETTRXIT EQU * 03408000 L R14,CMDCMDSV RESTORE RETURN REG 03409000 BR R14 AND RETURN 03410000 EJECT 03411000 *---------------------------------------------------------------------* 03412000 * BACKSPAC AND FWDSPACE COMMANDS * 03413000 *---------------------------------------------------------------------* 03414000 *. 03415000 * RESPONSES - 03416000 * 03417000 * NONE 03418000 * 03419000 * ERROR MESSAGES - 03420000 * 03421000 * DMTSML511E NO FILE ACTIVE ON LINK 'LINKID' 03422000 * 03423000 *. 03424000 SPACE 1 03425000 SETBACK EQU * 03426000 ST R14,CMDCMDSV SAVE RETURN REG 03427000 TM MASTERSW,READER IS THERE A READER ACTIVE? 03428000 BNO SBKFWDN NO ERROR 03429000 CLI CMDRESP+3,BACKFILE BACKSPAC FILE? 03430000 BNE SETBACK1 NO CONTINUE 03431000 OI RDRCMD,RBACKFIL INDICATE CMD FOR RDR PROCESSING 03432000 B SBKFWDE AND EXIT 03433000 SPACE 03434000 SETBACK1 EQU * 03435000 OI RDRCMD,RBACKCNT MUST BE BACKSPAC COUNT 03436000 MVC RDRCMDCT(4),CMDRESP+12 SAVE COUNT FOR RDR 03437000 B SBKFWDE AND EXIT 03438000 SPACE 03439000 SETFWD EQU * 03440000 ST R14,CMDCMDSV SAVE RETURN REGISTER 03441000 TM MASTERSW,READER IS THERE A READER ACTIVE 03442000 BNO SBKFWDN NO ERROR 03443000 MVC RDRCMDCT(4),CMDRESP+12 SAVE COUNT FOR READER 03444000 OI RDRCMD,RFWDCNT INDICATE COMMAND FOR READER 03445000 B SBKFWDE AND EXIT 03446000 SPACE 03447000 SBKFWDN EQU * 03448000 MSG 511,AXSLINK WRITE NO FILE ACTIVE MSG 03449000 SBKFWDE EQU * 03450000 MVC RDRCMDLK(8),CMDRESP+4 MOVE IN RESPONSE LINKID 03451000 L R14,CMDCMDSV RESTORE RETURN REG 03452000 BR R14 AND RETURN 03453000 EJECT 03454000 *---------------------------------------------------------------------* 03455000 * FLUSH COMMAND * 03456000 *---------------------------------------------------------------------* 03457000 *. 03458000 * RESPONSES - 03459000 * 03460000 * NONE 03461000 * 03462000 * ERROR MESSAGES - 03463000 * 03464000 * DMTSML511E NO FILE ACTIVE ON LINK 'LINKID' 03465000 * 03466000 *. 03467000 SPACE 1 03468000 SETFLUSH EQU * 03469000 ST R14,CMDCMDSV SAVE RETURN REG 03470000 MVC RDRCMDID(2),CMDRESP+12 SAVE FOR LATER COMPARE 03471000 LH R1,CMDRESP+12 GET SPOOLID 03472000 CVD R1,CMDCVD CONVERT TO DECIMAL 03473000 UNPK CMDFID,CMDCVD SPREAD THE DIGITS 03474000 OI CMDFID+3,X'F0' MAKE LAST PRINTABLE 03475000 TM MASTERSW,READER ARE WE SENDING A FILE? 03476000 BO SETFLSH1 YEP.. CONTINUE 03477000 MSG 581,CMDFID NO WRITE MSG 03478000 B SETFLSHE AND EXIT 03479000 SPACE 03480000 SETFLSH1 EQU * 03481000 CLI CMDRESP+3,FLUSHALL FLUSH ALL 03482000 BNE SETFLSH2 NO CONTINUE 03483000 OI RDRCMD,RFLSHALL SET RDRCMD BYTE 03484000 B SETFLSHE AND EXIT 03485000 SPACE 03486000 SETFLSH2 EQU * 03487000 CLI CMDRESP+3,FLUSHOLD FLUSH AND HOLD? 03488000 BNE SETFLSH3 NO MUST BE FLUSH COPY 03489000 OI RDRCMD,RFLSHOLD INDICATE CMD IN RDR CMD BYTE 03490000 B SETFLSHE AND EXIT 03491000 SPACE 03492000 SETFLSH3 EQU * 03493000 OI RDRCMD,RFLSHCPY INDICATE CMD IN RDR CMD BYTE 03494000 SETFLSHE EQU * 03495000 MVC RDRCMDLK(8),CMDRESP+4 MOVE IN RESPONSE LINKID 03496000 L R14,CMDCMDSV RESTORE RETURN REG 03497000 BR R14 AND RETURN 03498000 EJECT 03499000 *---------------------------------------------------------------------* 03500000 * CMD COMMAND * 03501000 *---------------------------------------------------------------------* 03502000 *. 03503000 * RESPONSES - 03504000 * 03505000 * DMTSML530I COMMAND FORWARDED ON LINK 'LINKID' 03506000 * 03507000 * ERROR MESSAGES - 03508000 * 03509000 * NONE 03510000 * 03511000 *. 03512000 SPACE 1 03513000 DS 0H 03514000 SETCMD EQU * 03515000 ST R14,CMDCMDSV SAVE RETURN 03516000 LA R7,WTCT SET TCTR 03517000 SPACE 1 03518000 MVC WCTTCT1(2),=X'0050' SET TANK COUNT 03519000 OC CMDRESP+12(8),BLANK TO UPPR CASE 03520000 CLC CMDRESP+12(3),=C'LOG' LOGING REQUESTED? 03521000 BNE CMD2A NOPE 03522000 OI $LOGSW,LOGON SET LOGING REQUESTED 03523000 L R14,CMDCMDSV RESTORE RETURN 03524000 BR R14 AND RETURN 03525000 SPACE 1 03526000 CMD2A EQU * 03527000 CLC CMDRESP+12(5),=C'NOLOG' TURN OFF LOGING? 03528000 BE LOGCLOSE YES 03529000 CMD12 EQU * 03530000 TM SMLSYS,MASTER IN HOST MODE? 03531000 BO CMDNRET COMMANDS NOT ALLOWED 03532000 MSG 530,AXSLINK WRITE COMMAND FORD MSG 03533000 EJECT 03534000 SR R1,R1 CLEAR OUT R1 OF IC 03535000 IC R1,CMDRESP GET LENGTH OF RESPONSE 03536000 SH R1,=H'12' CORRECT FOR HEADER 03537000 LTR R1,R1 IS THE RESULT NEGATIVE? 03538000 BM CMD2 YES, ZERO LENGTH REPLY @VA03860 03539000 EX R1,MSGMVC AND MOVE INTO MSG BUFFER 03540000 CMD12A EQU * 03541000 LA R8,WCTTANK1 GET THE TANK ADDRESS 03542000 BAL R14,$PUT AND WRITE THE TANK 03543000 CMD2 EQU * 03544000 MVI WCTTDTA1,C' ' PREPARE FOR BUFFER CLEAR 03545000 MVC WCTTDTA1+1(119),WCTTDTA1 CLEAR OUT THE WTOR BUFFER 03546000 CMDNRET EQU * 03547000 L R14,CMDCMDSV RESTORE RETURN 03548000 BR R14 AND RETURN 03549000 SPACE 1 03550000 MSGMVC MVC WCTTDTA1(0),CMDRESP+12 TO BE EXECUTED BY ABOVE CODE 03551000 CMDCMDSV DS F RETURN SAVE 03552000 EJECT 03553000 *---------------------------------------------------------------------* 03554000 * * 03555000 * COMMAND DATA AREA * 03556000 * * 03557000 *---------------------------------------------------------------------* 03558000 SPACE 03559000 STRTCMD EQU X'80' START COMMAND 03560000 DRCMD EQU X'81' DRAIN COMMAND 03561000 FREECMD EQU X'82' FREE COMMAND 03562000 HOLDCMD EQU X'83' HOLD COMMAND 03563000 TRACECMD EQU X'84' TRACE COMMAND 03564000 BACKCMD EQU X'90' BACKSPAC COMMAND 03565000 FWDCMD EQU X'91' FORWARD SPACE COMMAND 03566000 FLUSHCMD EQU X'A0' FLUSH COMMAND 03567000 CMDCMD EQU X'B0' COMMAND COMMAND 03568000 MSGCMD EQU X'B1' MESSAGE COMMAND 03569000 SPACE 03570000 * COMMAND MODIFIERS 03571000 TRACEOFF EQU X'C0' TRACE OFF 03572000 TRACERR EQU X'80' ERROR TRACE ON 03573000 TRACEALL EQU X'00' TRACE ALL ON 03574000 BACKCNT EQU X'80' BACKSPAC COUNT 03575000 BACKFILE EQU X'00' BACKSPAC FILE 03576000 FLUSHCPY EQU X'00' FLUSH COPY 03577000 FLUSHALL EQU X'80' FLUSH ALL 03578000 FLUSHOLD EQU X'40' FLUSH HOLD 03579000 HOLDIMM EQU X'80' HOLD IMMEDIATE 03580000 STACLASS EQU X'80' START RESET CLASS 03581000 SPACE 03582000 CMDSETUP DC A(CMDTABLE) COMMAND TABLE ADDRESS 03583000 DC A(CMDINC) 03584000 DC A(CMDEND-CMDINC) LAST ENTRY 03585000 SPACE 1 03586000 CMDINC EQU 4 LENGTH OF COMMAND TABLE ENTRY 03587000 SPACE 03588000 CMDTABLE DC 0F'0' 03589000 DC AL1(STRTCMD),AL3(SETSTART) 03590000 DC AL1(DRCMD),AL3(SETDRAIN) 03591000 DC AL1(FREECMD),AL3(SETFREE) 03592000 DC AL1(HOLDCMD),AL3(SETHOLD) 03593000 DC AL1(TRACECMD),AL3(SETTRACE) 03594000 DC AL1(BACKCMD),AL3(SETBACK) 03595000 DC AL1(FWDCMD),AL3(SETFWD) 03596000 DC AL1(FLUSHCMD),AL3(SETFLUSH) 03597000 DC AL1(CMDCMD),AL3(SETCMD) 03598000 CMDEND EQU * 03599000 SPACE 03600000 CMDCVD DC D'0' CONVERT AREA 03601000 CMDFID DC CL4' ' COMMAND SPOOLID AREA 03602000 DC CL4' ' 03603000 EJECT 03604000 RDRCMD DC X'00' READER COMMAND BYTE 03605000 * BITS DEFINED IN RDRCMD 03606000 RBACKFIL EQU X'80' BACKSPACE FILE 03607000 RBACKCNT EQU X'40' BACKSPACE COUNT 03608000 RFWDCNT EQU X'20' FORWARD SPACE COUNT 03609000 RFLSHCPY EQU X'10' FLUSH COPY 03610000 RFLSHALL EQU X'08' FLUSH ALL COPIES 03611000 RFLSHOLD EQU X'04' FLUSH AND HOLD 03612000 RHLDIPGS EQU X'02' HOLD IN PROGRESS 03613000 SPACE 03614000 HOLD EQU X'80' SUB OPTION ON CLOSE INPUT REQ 03615000 ALL EQU X'40' SUB OPTION ON CLOSE INPUT REQ 03616000 MULTOPEN EQU X'80' SUB OPTION ON OPEN OUTPUT REQ 03617000 SPACE 03618000 RDRCMDCT DC F'0' FILE SPACE COUNT 03619000 RDRCMDID DC H'0' CMD INDICATED SPOOLID 03620000 RDRCMDLK DC CL8' ' CMD RESPONSE LINKID 03621000 HLDCMDLK DC CL8' ' CMD RESPONSE LINKID 03622000 EJECT 03623000 *. 03624000 * 03625000 * ENTRY NAME - 03626000 * 03627000 * MSGPROC 03628000 * 03629000 * FUNCTION - 03630000 * 03631000 * THIS ROUTINE IS ENTERED WHEN THE MSGECB IS POSTED BY 03632000 * THIS TASK'S ASYNCHRONOUS EXIT, INDICATING MSGS ARE IN 03633000 * THE MSG QUEUE FOR THIS TASK. THIS MESSAGES ARE 03634000 * UNSTACKED FROM THE MSG QUEUE BY REPEATED CALLS TO 03635000 * GMSGREQ AND QUEUED FOR TRANSMISSION. 03636000 * 03637000 * CALLS TO OTHER ROUTINES - 03638000 * 03639000 * DMTCOM - TO UNSTACK THE MESSAGE 03640000 * 03641000 * OPERATION - 03642000 * 03643000 * 1. DEQUEUE MESSAGES FROM MESSAGE STACK VIA CALL TO GMSGREQ. 03644000 * 03645000 * 2. IF MESSAGE DEQUEUED SEND THE RECORD VIA CALL TO $PUT 03646000 * 03647000 * 3. EXIT TO COMMUTATOR. 03648000 * 03649000 * RESPONSES - 03650000 * 03651000 * NONE 03652000 * 03653000 * ERROR MESSAGES - 03654000 * 03655000 * NONE 03656000 * 03657000 *. 03658000 SPACE 3 03659000 MSGPROC EQU * 03660000 LA R7,WTCT ANOTHER CONSOLE USER 03661000 MVI $MSGCOM+1,CLOSE CLOSE THE GATE 03662000 TM WCTSTAT,TCTREL IS THE INTERLOCK ON? 03663000 BO MSGPROC2 YES..ALREADY PACKED..CONTINUE 03664000 MSGPROC1 EQU * 03665000 LA R1,WCTTCT1 USE THIS FOR A BUFFER 03666000 L R2,SMLLINK GET LINK TABLE ADDR 03667000 L R15,TCOM GET COMMON ROUTINES LIST 03668000 L R15,GMSGREQ INDICATE WE WANT A MSG 03669000 BALR R14,R15 GO GET ONE 03670000 LTR R15,R15 ANY AVAILABLE? 03671000 BNZ MSGPREOF SEND PSUEDO EOF @VA03480 03672000 IC R15,WCTTCT1 GET THE LENGTH OF MSG 03673000 SH R15,=H'8' SUBTRACT OUT LOCID @VA03279 03674000 MVC WCTTDTA1(120),WCTTDTA1+8 AND ADJUST MESSAGE @VA03279 03675000 CLC WCTTDTA1+6(3),SGNMSG IS THIS SIGN ON @VA06383 03676000 BNE MSGPROC3 SKIP OPENING READER @VA07621 03677000 OI $RCOMM1+1,OPEN OPEN READER @VA06383 03678000 MSGPROC3 EQU * NO OPEN READER YET @VA07621 03679000 STCM R15,B'0011',WCTTCT1 AND REPLACE IN THE TANKCNT 03680000 EJECT 03681000 MSGPROC2 EQU * 03682000 LA R8,WCTTANK1 LOAD THIS TANK ADDRESS 03683000 BAL R14,$PUT AND WRITE THE BUFFER 03684000 MVI WCTTDTA1,X'40' GET READY FOR CLEAR 03685000 MVC WCTTDTA1+1(119),WCTTDTA1 AND CLEAR 03686000 B MSGPROC1 AND GO GET ANOTHER 03687000 SPACE 1 03688000 MSGPREOF EQU * @VA03480 03689000 TM SMLSYS,MASTER HOST MODE? @VA03480 03690000 BNO $MSGCOM+4 NO CONTINUE @VA03480 03691000 L R8,OBUFPTR GET ADDR OF ACTIVE BUFFER @VA03863 03692000 C R8,=F'0' IS THERE ONE? @VA03863 03693000 BE $MSGCOM+4 NO, JUST RETURN @VA03863 03694000 MVC WCTTCT1(2),=H'0' SET EOF RECORD @VA03480 03695000 LA R8,WCTTANK1 GET TANK ADDRESS @VA03480 03696000 BAL R14,$PUT SEND THE RECORD @VA03480 03697000 B $MSGCOM+4 AND RETURN @VA03480 03698000 SGNMSG DC C'905' SIGNON MSG NUMBER @VA06383 03699000 EJECT 03700000 *. 03701000 * 03702000 * ENTRY NAME - 03703000 * 03704000 * MSG 03705000 * 03706000 * FUNCTION - 03707000 * 03708000 * THIS ROUTINE PREPARES AND SENDS REQUESTS TO THE 03709000 * SPECIALIZED TASK REX, IN ORDER TO WRITE MESSAGES 03710000 * ON THE OPERATOR'S CONSOLE. 03711000 * 03712000 * CALLS TO OTHER ROUTINES - 03713000 * 03714000 * DMTREX - TO EXECUTE THE MSG WRITE 03715000 * 03716000 * OPERATION - 03717000 * 03718000 * 1. MOVE VARIABLE PART OF MSG TO GIVE REQUEST BUFFER 03719000 * 03720000 * 2. INITIATE GIVE REQUEST TO DMTREX WITH MSG BUFFER. 03721000 * 03722000 * 3. WAIT FOR COMPLETION 03723000 * 03724000 * 4. RETURN TO CALLER 03725000 * 03726000 * ENTRY CONDITIONS: 03727000 * 03728000 * IN REG. 14 THE RETURN ADDRESS 03729000 * IN REG. 15 THE ROUTING CODE 03730000 * IN REG. 1 THE POINTER TO THE VARIABLE PORTION OF 03731000 * THE MESSAGE STRING 03732000 * IN REG. 0 THE LENGTH OF THE VARIABLE PORTION OF THE MSG 03733000 * 03734000 * EXIT CONDITIONS: 03735000 * 03736000 * NONE 03737000 * 03738000 * NOTE: 03739000 * NONE 03740000 * 03741000 * RESPONSES - 03742000 * 03743000 * NONE 03744000 * 03745000 * ERROR MESSAGES - 03746000 * 03747000 * NONE 03748000 * 03749000 *. 03750000 EJECT 03751000 MSG DC 0H'0' 03752000 STM R14,R2,MSGSAVE SAVE REGISTERS 03753000 LR R2,R0 MOVE R0 INTO WORK REG 03754000 BCTR R2,0 REDUCE BY ONE FOR MVC 03755000 EX R2,MSGMVC1 AND MOVE TO MSG REQ BUFFER 03756000 AH R2,=H'24' UP FOR HEADER 03757000 STC R2,MSGBLK AND STORE IN MSG REQ BUFFER 03758000 CLI MSGLINK,X'00' NEED ROUTING? 03759000 BNE MSG1 NO CONTINUE 03760000 MVC MSGLINK(8),AXSLINK MOVE IN OUR LINKID 03761000 MSG1 EQU * 03762000 LA R1,MSGREQ GET READY FOR GIVE 03763000 XC MSGREQ(4),MSGREQ CLEAR OUT SYNCH LOCK 03764000 L R15,GIVEREQ SYSTEM GIVE REQUEST EXECUTATOR 03765000 BALR R14,R15 GO GIVE THE BUFFER TO REX 03766000 L R15,WAITREQ WAIT FOR THE COMPLETION OF 03767000 BALR R14,R15 CONSOLE OPERATION 03768000 MVI MSGLINK,X'00' SHOW NO RESPONSE 03769000 MVI MSGBLK+2,X'00' INDICATE NO ROUTING 03770000 LM R14,R2,MSGSAVE RESTORE REGS 03771000 BR R14 AND RETURN 03772000 SPACE 03773000 MSGMVC1 MVC MSGBUF(0),0(R1) TO BE EXECUTED FROM ABOVE 03774000 SPACE 03775000 DS 0F 03776000 MSGREQ DC F'0' SYNCH LOCK 03777000 DC CL4'REX ' TASK NAME 03778000 DC A(MSGBLK) REQUEST BUFFER 03779000 DC A(0) NO RESPONSE 03780000 SPACE 1 03781000 MSGBLK DC AL1(0),AL1(2),AL1(0),AL1(0) LENGTH,FUNCTION,ROUTE,SEV 03782000 MSGLINK DC 8X'00' LINKID 03783000 MSGVMID DC CL8' ' VIRTUAL MACHINE ID 03784000 DC CL3'SML',CL1' ' MODULE ID PLUS ACTION CODE 03785000 MSGBUF DC CL120' ' MSG BUFFER 03786000 SPACE 03787000 MSGSAVE DC 5F'0' SAVE AREA 03788000 EJECT 03789000 *. 03790000 * 03791000 * ENTRY NAME - 03792000 * 03793000 * PARMGET 03794000 * 03795000 * FUNCTION - 03796000 * 03797000 * LINE SCANNING SUBROUTINE 03798000 * 03799000 * CALLS TO OTHER ROUTINES - 03800000 * 03801000 * NONE 03802000 * 03803000 * OPERATION - 03804000 * 03805000 * 1. TEST FOR DELIMETER CHARACTER 03806000 * 03807000 * 2. WHEN FOUND OR END OF STRING FOUND UPDATE R4 03808000 * 03809000 * 3. AND RETURN 03810000 * 03811000 * ENTRY - 03812000 * REG.3 = ADDRESS OF START OF STRING 03813000 * REG.5 = ADDRESS OF END OF STRING 03814000 * 03815000 * EXIT - 03816000 * REG.3 = FIRST NONDELIMETER CHARACTER SCANNED; 03817000 * IF NONE FOUND, END OF STRING 03818000 * REG.4 = UNMODIFIED IF NO NONDELIMETER CHAR SCANNED; 03819000 * OTHERWISE, ADDRESS OF FIRST DELIMETER CHAR 03820000 * AFTER FIRST NONDELIMETER CHAR SCANNED; 03821000 * IF NONE, END OF STRING. 03822000 * REG.5 = UNMODIFIED 03823000 * 03824000 * A DELIMETER CHAR IS ANY CHARACTER OF THE FORM B'XX000000' 03825000 * 03826000 * RESPONSES - 03827000 * 03828000 * NONE 03829000 * 03830000 * ERROR MESSAGES - 03831000 * 03832000 * NONE 03833000 * 03834000 *. 03835000 EJECT 03836000 PARMGET DC 0H'0' 03837000 LA R5,0(R5) CLEAR HIGH ORDER BYTE JUST IN CASE 03838000 BCTR R3,0 BUMP START OF STRING PTR BACK FOR C 03839000 PARMFIND EQU * 03840000 LA R3,1(R3) LOOK AT THE NEXT CHARACTER 03841000 CLR R3,R5 HAVE WE HIT THE END OF THE STRING? 03842000 BCR 11,R14 (BNL) YEP - LOOK NO MORE 03843000 TM 0(R3),X'3F' IS THIS CHARACTER A DELIMETER? 03844000 BZ PARMFIND YEP- KEEP LOOKING FOR A NONDELIMETER 03845000 LR R4,R3 SET UP FOR NEXT PHASE OF SCAN 03846000 PARMSCAN EQU * 03847000 LA R4,1(R4) LOOK AT THE NEXT CHARACTER 03848000 CLR R4,R5 ARE WE AT THE END OF THE STRING YET? 03849000 BCR 11,R14 (BNL) RETURN IMMEDIATELY IF SO 03850000 TM 0(R4),X'3F' IS THIS CHARACTER A DELIMETER? 03851000 BNZ PARMSCAN KEEP SCANNING FOR A DELIMETER IF NOT 03852000 BR R14 OTHERWISE ALL DONE - RETURN 03853000 EJECT 03854000 *---------------------------------------------------------------------* 03855000 * * 03856000 * FILE ACCESS INTERFACE * 03857000 * * 03858000 *---------------------------------------------------------------------* 03859000 SPACE 1 03860000 * 03861000 * ON ENTRY: R1 --> DEVICE REQUEST BLOCK 03862000 * R0 = AXS REQUEST CODE 03863000 * 03864000 * ON EXIT: 03865000 * R15 = AXS RETURN CODE 03866000 * 03867000 AXS DS 0H 03868000 ST R14,AXSAVE SAVE RETURN REGISTER 03869000 STC R0,17(R1) SET REQUESTED FUNCTION 03870000 XC 0(4,R1),0(R1) CLEAR REQUEST SYNCH LOCK 03871000 L R15,GIVEREQ GIVE REQUEST ADDRESS 03872000 BALR R14,R15 GIVE THE REQUEST TO SUPERVISOR 03873000 L R15,WAITREQ WAIT REQUEST 03874000 BALR R14,R15 WAIT FOR OPERATION TO COMPLETE 03875000 XC 0(4,R1),0(R1) CLEAR OUT SYNC LOCK 03876000 L R14,AXSAVE RESTORE RETURN ADDRESS 03877000 BR R14 RETURN TO CALLER 03878000 SPACE 1 03879000 AXSAVE DS F AXS SAVE AREA 03880000 EJECT 03881000 *. 03882000 * 03883000 * ENTRY NAME - 03884000 * 03885000 * $TPPUT 03886000 * 03887000 * FUNCTION - 03888000 * 03889000 * THIS ROUTINE TAKES A LINE AND PACKS IT INTO A TELE- 03890000 * PROCESSING BUFFER. WHEN A BUFFER IS FILLED IT IS QUEUED 03891000 * ONTO $OUTBUF FOR PROCESSING BY COMSUP. 03892000 * 03893000 * CALLS TO OTHER ROUTINES - 03894000 * 03895000 * NONE 03896000 * 03897000 * OPERATION - 03898000 * 03899000 * 1. FIND THE CURRENT TP BUFFER FOR THE CALLING 03900000 * PROCESSOR. 03901000 * 03902000 * 2. COMPRESS THE RECORD IN THE SUPPLIED TANK. 03903000 * 03904000 * 3. TRY TO FIT IN THE EXISTING TP BUFFER. 03905000 * 03906000 * 4. IF RECORD WILL NOT FIT, QUEUE CURRENT 03907000 * RECORD FOR TRANSMISSION, OBTAIN A NEW BUFFER 03908000 * AND ADD RECORD TO IT. 03909000 * 03910000 * 5. FOR OPERATOR MESSAGES, PROCESS ONLY ONE RECORD 03911000 * PER BUFFER. 03912000 * 03913000 * 6. RETURN TO CALLER 03914000 * 03915000 * RESPONSES - 03916000 * 03917000 * NONE 03918000 * 03919000 * ERROR MESSAGES - 03920000 * 03921000 * NONE 03922000 * 03923000 *. 03924000 EJECT 03925000 * 03926000 * $PUT ROUTINE INTERFACE WITH $TPPUT 03927000 * 03928000 * R8 POINTS TO TANK, R14 POINTS TO RETURN, TCTR POINTS TO TCT 03929000 * 03930000 USING TANKDSEC,R8 03931000 USING TCTDSECT,TCTR 03932000 SPACE 1 03933000 $PUT DS 0H 03934000 ST R14,TCTSAV1 SAVE RETURN ADDRESS 03935000 ST R8,TCTCCW SAVE TANK ADDRESS 03936000 OXLOOP EQU * 03937000 TM TCTSTAT,TCTREL IS INTERLOCK RELEASE ON 03938000 BZ OXPUT IF NOT DO NORMAL $TPPUT 03939000 LA R8,WCTTANK1 PICK UP CONSOLE TANK ADDRESS 03940000 BAL R14,$TPREPUT ATTEMPT TO SEND 03941000 L R14,TCTSAV1 PICK UP RETURN ADDR 03942000 BNE OXFINTST IF TANK OK TEST FOR MORE WORK 03943000 MVI CMDINPGS,X'00' RESET FLAG @VM01164 03944000 MVI $MSGCOM+1,CLOSE CLOSE THIS PROCESSOR @VA03480 03945000 B $START RETURN TO TOP OF COMMUTATOR @VA03480 03946000 SPACE 1 03947000 OXFINTST EQU * 03948000 NI WCTSTAT,255-TCTREL RESET INTERLOCK RELEASE 03949000 BR R14 AND RETURN 03950000 SPACE 1 03951000 OXPUT EQU * 03952000 BAL R14,$TPPUT SUBMIT TANK FOR TRANSMISSION 03953000 L R14,TCTSAV1 RESTORE RETURN POINTER 03954000 BNER R14 IF TANK WENT OK THEN RETURN 03955000 TM TCTSTAT,TCT1052 IF NOT TEST FOR CONSOLE 03956000 BZ OXWAIT IF NOT CONSOLE WAIT 03957000 OI WCTSTAT,TCTREL SET INTERLOCK RELEASE INDICATOR 03958000 MVI CMDINPGS,X'00' RESET FLAG @VM01164 03959000 MVI $MSGCOM+1,CLOSE CLOSE THIS PROCESSOR @VA03480 03960000 B $START RETURN TO TOP OF COMMUTATOR @VA03480 03961000 SPACE 1 03962000 OXWAIT EQU * 03963000 DS 0H WAIT TO RESUBMIT TANK 03964000 MVC TCTENTY(2),OBUFNOW SET UP FOR REENTRY 03965000 L R6,TCTCOM GET COMMUTATOR ENTRY 03966000 MVI 1(R6),CLOSE AND CLOSE GATE 03967000 MVI TCTWFB,X'FF' SET READER-WAITING-FOR-BUFFER 03968000 B TCTRTN AND RETURN 03969000 EJECT 03970000 BUFNOW EQU * 03971000 MVI TCTWFB,X'00' RESET WAIT SWITCH 03972000 L R6,TCTCOM GET COMMUTATOR ENTRY 03973000 MVI 1(R6),CLOSE AND CLOSE GATE 03974000 L R8,TCTCCW PICK UP TANK ADDRESS 03975000 BAL R14,$TPREPUT RESUBMIT TANK FOR TRANSMISSION 03976000 L R14,TCTSAV1 PICK UP USER RETURN POINT 03977000 BE OXWAIT WAIT 03978000 BR R14 RETURN 03979000 DROP R8 03980000 SPACE 1 03981000 OBUFNOW DC S(BUFNOW) RENTRY POINT 03982000 EJECT 03983000 *---------------------------------------------------------------------* 03984000 * * 03985000 * ENTRY - $TPPUT * 03986000 * REGISTERS - R8=RECORD TANK 2(R8)=RCB,3(R8)=SRCB * 03987000 * R14=RETURN ADDR ,CC=0 - RECORD NOT TAKEN * 03988000 * CC.NE.0-RECORD ACCEPTED * 03989000 * R15 IS CONSIDERED VOLITILE * 03990000 * * 03991000 * * 03992000 *---------------------------------------------------------------------* 03993000 SPACE 1 03994000 $TPPUT DS 0H 03995000 ST R14,OSAVR14 SAVE RETURN 03996000 ST R5,OSAVR5 SAVE REGISTERS 03997000 ST R6,OSAVR6 SAVE REGISTERS 03998000 ST R8,OINADD SAVE INPUT TANK ADDR 03999000 L R15,=F'1' GET COUNTER 04000000 L R5,OINADD COMPRESSION WORK AREA 04001000 A R5,=A(TANKRCB-TANKDSEC) GET RCB ADDR 04002000 USING TANKDSEC,R8 * 04003000 LH R6,TANKCNT TANK DATA COUNT 04004000 CH R6,=H'0' IS THIS A NULL RECORD 04005000 BE OEOINCHK BR IF YES TO CHECK EOF @VA03480 04006000 AR R6,R8 INCLUDE TANK ADDR 04007000 ST R6,OINEND TO SAFE STORAGE 04008000 CLI OTS(R8),2 IS THIS A TEXT CARD 04009000 BNE OGOA BR IF NO 04010000 SPACE 1 04011000 * SKIP ATTEMPTING TO COMPRESS A TEXT CARD 04012000 LH R6,TANKCNT INPUT COUNT 04013000 LTR R4,R8 INPUT ADDR 04014000 AR R8,R6 END OF RECORD 04015000 B OSQUEEZE GO PROCESS RECORD 04016000 SPACE 1 04017000 OGOA DS 0H 04018000 MVI OTS(R6),0 SETUP ENDING CHARACTER 04019000 CLI OTS-1(R6),0 DOES ENDING MATCH LAST DATA CHAR 04020000 BNE OGOB BR IF NOT 04021000 MVI OTS(R6),255 YES...USE ANOTHER 04022000 OGOB EQU * 04023000 MVC OTS+1(3,R6),OTS(R6) PROPAGATE FOR DUPLICATION 04024000 OGO DS 0H 04025000 LA R14,OGO1 LOAD FOR SPEED 04026000 LA R13,OSQUEEZE LOAD FOR SPEED 04027000 SR R6,R6 INITIAL COUNTER FOR MVC 04028000 LTR R4,R8 INPUT AREA TO R4 04029000 OGO1 DS 0H 04030000 CLC OTS(3,R8),OTS+1(R8) CHECK FOR COMPRESSABILITY 04031000 BCR 8,R13 BR IF COMPRESSABLE (TO OSQUEEZE) 04032000 AR R8,R15 UP DATA PTR 04033000 AR R6,R15 AND CHAR COUNT 04034000 BR R14 CONTINUE (TO OGO1) 04035000 EJECT 04036000 *---------------------------------------------------------------------* 04037000 * * 04038000 * OSQUEEZE - IDENTICAL CHARACTERS FOUND * 04039000 * * 04040000 *---------------------------------------------------------------------* 04041000 SPACE 2 04042000 OSQUEEZE DS 0H * 04043000 CH R6,=H'0' IS A CHARACTER STRING ACTIVE 04044000 BE OCOMPTST BR IF NO TO COMPRESS 04045000 CH R6,=H'63' DOES STRING EXCEED SCB 04046000 BH OBIGMOVE BR IF YES 04047000 EX R6,OMVC1A MOVE TO TEMP BUFF THEN TO TANK @VA04175 04048000 EX R6,OMVC1B -TO AVOID CHARACTER PROPAGATION @VA04175 04049000 STC R6,2(R5) SET SCB COUNT 04050000 OI 2(R5),X'C0' SET SCB ID BITS 04051000 AR R5,R6 FIX OUTPUT POINTER 04052000 AR R5,R15 COUNT SCB 04053000 OCOMPTST DS 0H 04054000 C R8,OINEND TEST FOR EOI 04055000 BNL OEOINPUT BR IF YES 04056000 OCOMP DS 0H 04057000 LA R14,OCOMP1 FOR LOOP SPEED 04058000 LA R13,OCMPSTOP FOR LOOP SPEED 04059000 LH R6,=Y(4) START COMPRESSION COUNTER 04060000 OCOMP1 DS 0H CONTINUE COMPRESSION TESTING 04061000 CLC OTS+3(1,R8),OTS+4(R8) DOES MATCH CONTINUE 04062000 BCR 7,R13 BR IF NO (TO CMPSTOP) 04063000 AR R6,R15 ANOTHER MATCH... COUNT IT 04064000 AR R8,R15 UP TO NEXT CHAR 04065000 BR R14 CONTINUE (TO OCOMP1) 04066000 SPACE 1 04067000 OMVC1A MVC OTEMP(*-*),OTS(R4) EXECUTED BY ABOVE CODE @VA04175 04068000 OMVC1B MVC 3(*-*,R5),OTEMP EXECUTED BY ABOVE CODE @VA04175 04069000 SPACE 1 04070000 OCMPSTOP DS 0H IDENTICAL STRING ENDED 04071000 CH R6,=H'31' DOES IT EXCEED SCB... 04072000 BH OBIGPROP BR IF YES 04073000 STH R6,$TEMP TO TEMPORARY STORAGE 04074000 OI $TEMP+1,X'80' SET SCB ALWAYS BIT 04075000 MVC 2(1,R5),$TEMP+1 SET SCB 04076000 CLI OTS+3(R8),C' ' ARE WE SQUEEZING BLANKS 04077000 BE OBLANK BR IF YES 04078000 MVC 3(1,R5),OTS+3(R8) SET DUPLICATION CHAR 04079000 OI 2(R5),X'20' SHOW NON-BLANK DUPLICATION 04080000 AR R5,R15 SKIP SAMPLE CHAR 04081000 OBLANK DS 0H 04082000 AR R5,R15 COUNT SCB 04083000 A R8,=A(4) UP TO NEXT 04084000 B OGO AND CONTINUE RECORD 04085000 EJECT 04086000 OBIGPROP DS 0H DUPLICATION COUNT EXCEEDS SCB 04087000 MVI 2(R5),X'9F' SHOW MAX SCB 04088000 CLI OTS+3(R8),C' ' IS THIS BLANKS 04089000 BE OBIGBLNK BR IF YES 04090000 MVC 3(1,R5),OTS+3(R8) SET SAMPLE CHAR 04091000 OI 2(R5),X'20' SHOW NON-BLANK 04092000 AR R5,R15 COUNT SAMPLE 04093000 OBIGBLNK DS 0H EXCESSIVE COUNT BLANKS 04094000 AR R5,R15 COUNT SCB 04095000 SH R6,=H'31' ADJUST COUNT 04096000 B OCMPSTOP AND TRY AGAIN 04097000 SPACE 1 04098000 OBIGMOVE DS 0H STRING COUNT EXCEEDS SCB MAXIMUM 04099000 MVC 3(63,R5),OTS(R4) MOVE MAX 04100000 MVI 2(R5),X'FF' SET MAX SCB 04101000 A R5,=F'64' ADD IN COUNT 04102000 A R4,=F'63' ADD IN COUNT 04103000 SH R6,=H'63' REDUCE COUNT 04104000 B OSQUEEZE AND TRY AGAIN 04105000 SPACE 1 04106000 OEOINCHK EQU * @VA03480 04107000 TM SMLSYS,MASTER HOST MODE? @VA03480 04108000 BNO OEOINPUT NO..CONTINUE @VA03480 04109000 CLC TANKRCB(1),WCTTRCB1 MESSAGES? @VA03480 04110000 BE OFLUSH JUST FLUSH THE BUFFER AS IS @VA03480 04111000 EJECT 04112000 *---------------------------------------------------------------------* 04113000 * * 04114000 * END OF INPUT RECORD - TERMINATE AND ADD TO BUFFER * 04115000 * * 04116000 *---------------------------------------------------------------------* 04117000 SPACE 1 04118000 OEOINPUT EQU * 04119000 MVI 2(R5),0 END-OF-RECORD SCB 04120000 AR R5,R15 COUNT IT 04121000 L R8,OINADD STARTING ADDR OF COMPRESSED REC 04122000 SR R5,R8 REDUCE TO ACTUAL COUNT 04123000 SH R5,=AL2(L'TANKCHN-2) COMPENSATE FOR FULL CHAIN WORD 04124000 STH R5,TANKCHN SAVE COUNT IN TANK FOR $TPREPUT 04125000 OREENT DS 0H RE-ENTRY POINT FROM $TPREPUT 04126000 L R6,OBUFPTR GET ADDR OF ACTIVE BUFFER 04127000 C R6,=F'0' END? 04128000 BE OGETBUF BR IF NO 04129000 OBUFOK DS 0H VALID BUFFER 04130000 CH R5,OBUFCNT WILL THIS RECORD FIT... 04131000 BH OBUFFULL BR IF NO 04132000 EX R5,OMVC2 MOVE RECORD 04133000 AR R6,R5 UPDATE CURRENT PTR 04134000 ST R6,OBUFPTR AND RESET 04135000 LH R6,OBUFCNT REMAINING COUNT 04136000 SR R6,R5 REDUCE BY THIS RECORD 04137000 STH R6,OBUFCNT AND RESET 04138000 CH R5,=H'3' WAS THIS A NULL RECORD 04139000 BE OFLUSH BR IF YES TO WRITE BUFFER 04140000 TM SMLSYS,MASTER HOST MODE? @VA03480 04141000 BO ORETOK YES..SKIP CHECK @VA03480 04142000 CLC TANKRCB(1),WCTTRCB1 IS THIS OPER CMD 04143000 BE OFLUSH BR IF YES TO SEND BUFFER 04144000 ORETOK DS 0H POSITIVE RETURN ENTRY 04145000 OI BUFSYNSW,OFLSW OPEN NORMAL GATE AND SET COND CODE 04146000 ORETURN DS 0H RETURN--COND. CODE ALREADY SET 04147000 L R8,OINADD RESTORE TANK ADDR 04148000 L R6,OSAVR6 RESTORE REG 04149000 L R5,OSAVR5 RESTORE REG 04150000 L R14,OSAVR14 GET RETURN 04151000 BR R14 AND DO IT 04152000 SPACE 1 04153000 OMVC2 MVC 0(0,R6),L'TANKCHN(R8) TO BE EXECUTED FROM ABOVE 04154000 EJECT 04155000 OGETBUF DS 0H 04156000 TM BUFSYNSW,$TPPNONE SHOULD WE STOP BUFFERING? 04157000 BO OGETBUF1 BUFFERING STOP @VA03306 04158000 CLC $BUFPOOL,=F'0' ARE WE EMPTY? 04159000 BE ORETURN BR IF NONE (NOTE COND. CODE SET) 04160000 L R6,$BUFPOOL GET FIRST BUFFER ADDR 04161000 CLC 0(4,R6),=F'0' ONLY ONE LEFT???? @VA03301 04162000 BE ORETURN YEP...BETTER NOT USE IT @VA03301 04163000 MVC $BUFPOOL(4),0(R6) REMOVE THIS ONE FROM CHAIN 04164000 ST R6,OACTBUF SET BUFFER ADDR 04165000 A R6,=A(BUFDATA-BUFDSECT) 04166000 ST R6,OBUFPTR SET CURRENT POINTER 04167000 L R14,TPBUFSIZ GET TP BUFFER SIZE 04168000 SH R14,=Y(BUFDATA+2-BUFSTART+2) ALLOW FOR HDR,ETB @VA03348 04169000 STH R14,OBUFCNT AND SAVE 04170000 B OBUFOK AND GO FIT RECORD 04171000 SPACE 1 04172000 OGETBUF1 EQU * @VA03306 04173000 SR R6,R6 SET CONDITION CODE FIRST @VA03306 04174000 B ORETURN AND RETURN @VA03306 04175000 EJECT 04176000 *---------------------------------------------------------------------* 04177000 * * 04178000 * BUFFER IS FULL--SEND IT * 04179000 * * 04180000 *---------------------------------------------------------------------* 04181000 SPACE 1 04182000 OFLUSH DS 0H ENTRY TO WRITE A PARTIAL BUFFER 04183000 NI BUFSYNSW,255-OFLSW SET FLUSH SWITCH 04184000 OBUFFULL DS 0H 04185000 L R6,OBUFPTR GET CURRENT BUFFER POINTER 04186000 L R13,OACTBUF FOR $EXTP 04187000 USING BUFDSECT,R13 GET TP BUFFER ADDRESSABILITY 04188000 MVI 0(R6),0 SET EOB 04189000 SR R6,R13 SUBTRACT SOB 04190000 SH R6,=Y(BUFSTART-BUFDSECT-1) MAKE COUNT ACTUAL 04191000 STH R6,BUFCOUNT SET COUNT 04192000 SR R6,R6 ZERO 04193000 ST R6,OBUFPTR AND SHOW NO BUFFER 04194000 SPACE 1 04195000 USING BUFDSECT,R13 BUFFER ADDR IS IN R13 04196000 LA R6,$OUTBUF QUEUE CONTROL WORD 04197000 OBUFLOP EQU * 04198000 CLC 0(4,R6),=F'0' IS IT THE LAST.QUEUE FOR TRANS 04199000 BE OBUFLOP1 YES 04200000 L R6,0(0,R6) GET THE NEXT ONE 04201000 B OBUFLOP AND COMPARE 04202000 SPACE 1 04203000 OBUFLOP1 EQU * 04204000 ST R13,0(0,R6) CHAIN THIS ONE TO IT 04205000 MVC 0(4,R13),=F'0' SET NEW FORWARD ZERO 04206000 SPACE 1 04207000 TM BUFSYNSW,OFLSW SHOULD WE FLUSH THE BUFFER? 04208000 BO OGETBUF NO 04209000 B ORETOK JUST RETURN IF FLUSH 04210000 DROP R13 04211000 EJECT 04212000 *---------------------------------------------------------------------* 04213000 * * 04214000 * RE-ENTRY POINT IF ORIGINAL $TPPUT NOT ACCEPTED * 04215000 * R8=ORIGINAL TANK , R14= RETURN * 04216000 * * 04217000 *---------------------------------------------------------------------* 04218000 SPACE 1 04219000 $TPREPUT DS 0H 04220000 ST R8,OINADD SET FOR RESTORE 04221000 ST R14,OSAVR14 RESET RETURN 04222000 ST R5,OSAVR5 SAVE REG 04223000 ST R6,OSAVR6 SAVE REG 04224000 LH R15,=H'1' CONSTANT 04225000 LH R5,TANKCHN COMPRESSED COUNT 04226000 B OREENT ENTER FLOW 04227000 DROP R8 04228000 EJECT 04229000 *---------------------------------------------------------------------* 04230000 * * 04231000 * $TPPUT STORAGE * 04232000 * * 04233000 *---------------------------------------------------------------------* 04234000 SPACE 1 04235000 OSAVR6 DC A(0) REG SAVE 04236000 OSAVR5 DC A(0) REG SAVE 04237000 OSAVR14 DC A(0) RETURN ADDR SAVE 04238000 OINADD DC A(0) INPUT TANK ADDR 04239000 OINEND DC A(0) LAST VALID DATA BYTE IN TANK 04240000 OACTBUF DC A(0) ACTIVE BUFFER ADDR 04241000 OBUFPTR DC A(0) CURRENT POINTER IN BUFFER 04242000 OBUFCNT DC H'0' REMAING SPACE COUNT IN BUFFER 04243000 OTEMP DS CL64 COMPRESSION WORK AREA @VA04175 04244000 OTS EQU 8 04245000 EJECT 04246000 *. 04247000 * 04248000 * ENTRY NAME - 04249000 * 04250000 * $TPGET 04251000 * 04252000 * FUNCTION - 04253000 * 04254000 * THIS ROUTINE DEBLOCKS RECEIVED TELECOMMUNICATIONS 04255000 * BUFFERS INTO TANKS AND QUEUES THE TANK ONTO THE 04256000 * APPROPRIATE PROCESSORS TCTTANK QUEUE. 04257000 * 04258000 * CALLS TO OTHER ROUTINES - 04259000 * 04260000 * NONE 04261000 * 04262000 * OPERATION - 04263000 * 04264000 * 1. GET A BUFFER FROM $INPUF QUEUE AND LOOK FOR 04265000 * A MATCHING TCT TO ATTACH THE BUFFER TO BY COMPARING 04266000 * RCBS. 04267000 * 04268000 * 2. GET A TANK TO DECOMPRESS A BUFFER INTO. 04269000 * 04270000 * 3. DECOMPRESS THE BUFFER INTO THE TANK 04271000 * 04272000 * 4. CHAIN THE TANK TO THE TCT TANK QUEUE FOR THE 04273000 * PROCESSOR BEING SERVICED AND OPEN THE COMMUTATOR 04274000 * GATE FOR THAT PROCESSOR. 04275000 * 04276000 * RESPONSES - 04277000 * 04278000 * NONE 04279000 * 04280000 * ERROR MESSAGES - 04281000 * 04282000 * NONE 04283000 * 04284000 *. 04285000 SPACE 3 04286000 * 04287000 * 04288000 $TPGET DS 0H ENTERED FROM COMUTATOR 04289000 MVI $TPGETCM+1,CLOSE CLOSE COMMUTATOR 04290000 GDQ EQU * 04291000 TM BUFSYNSW,GDQBUFS STOP ALL BUFFERING? 04292000 BO GWAIT YES 04293000 GDQBUFS1 DS 0H BEGIN DEQUEUING CYCLE 04294000 CLC $INBUF,=F'0' ARE WE EMPTY? 04295000 BE GCONTTCT YES 04296000 L R6,$INBUF GET FIRST BUFFER ADDR 04297000 MVC $INBUF(4),0(R6) REMOVE THIS ONE FROM CHAIN 04298000 SPACE 1 04299000 GDQBUFS2 EQU * 04300000 LA R8,BUFDATA-BUFDSECT DATA DISPLACEMENT 04301000 AR R8,R6 R8=ACTUAL DATA ADDRESS 04302000 BAL R14,GASSIGN GO ATTACH BUFFER TO TCT 04303000 B GDQBUFS1 AND CHECK AGAIN 04304000 SPACE 1 04305000 GCONTTCT DS 0H SERVICE TCT'S 04306000 OI BUFSYNSW,GDQBUFS CLOSE DEQUE SW 04307000 SPACE 1 04308000 LA R13,$TCT1 BEGINNING OF TCT'S 04309000 USING TCTDSECT,R13 ** 04310000 GTEST DS 0H * 04311000 TM TCTSTAT,TCTACT IS ACTION REQUESTED 04312000 BO GSERVICE BR IF YES 04313000 GNEXTTCT DS 0H 04314000 ICM R13,B'1111',TCTNEXT TO NEXT TCT AND CHECK FOR END 04315000 BNZ GTEST BR IF NO 04316000 * 04317000 * ALL TCT'S HAVE BEEN SERVICED... 04318000 * 04319000 B GDQ GO TEST FOR MORE BUFFERS 04320000 EJECT 04321000 * 04322000 * SERVICE TCT WITH ACTION BIT ON 04323000 * 04324000 GSERVICE DS 0H 04325000 CLI TCTBUFCT,0 ARE ANY BUFFERS AVAILABLE 04326000 BNE GTTANK BR IF YES 04327000 GNOACT EQU * 04328000 NI TCTSTAT,255-TCTACT NO... TURN OFF ACTION 04329000 B GNEXTTCT AND CONTINUE 04330000 SPACE 1 04331000 GTTANK DS 0H A BUFFER IS PRESENT 04332000 CLC TCTTNKCT,TCTTNKLM ARE SUFFICIENT TANKS QUEUED 04333000 BNL GNOACT BR IF YES 04334000 SPACE 1 04335000 * A DECOMPRESSION IS REQUIRED 04336000 CLC $TANKPOL,=F'0' ARE WE EMPTY 04337000 BE GWAIT 04338000 L R5,$TANKPOL GET FIRST BUFFER ADDR 04339000 MVC $TANKPOL(4),0(R5) REMOVE THIS ONE FROM CHAIN 04340000 USING TANKDSEC,R5 * 04341000 MVI TANKDATA,C' ' SET TO CLEAR TANK @VA06381 04342000 MVC TANKDATA+1(199),TANKDATA CLEAR TANK @VA06381 04343000 L R8,TCTBUFER CURRENT BUFFER 04344000 LH R15,(BUFCOUNT-BUFDSECT)(0,R8) GET COUNT 04345000 AR R8,R15 ADD TO CURRENT COUNT 04346000 ST R5,GTANK SAVE TANK ADDR. 04347000 MVC TANKRCB(2),0(R8) MOVE RCB AND SRCB 04348000 LH R15,=H'1' CONSTANT FOR SPEED 04349000 CLI 0(R8),X'F0' IS IT A GENERAL CONTROL RCB? @VA03347 04350000 BNE GDECOMP NO, GO & DECOMPRESS THE BUFFER @VA03347 04351000 MVC TANKDATA(78),2(R8) YES, MOVE 78 BYTES INTO TANK @VA03347 04352000 LA R8,78(R8) UPDATE POINTER IN BUFFER @VA03347 04353000 LA R5,78(R5) UPDATE POINTER IN TANK @VA03347 04354000 MVI 2(R8),X'00' PUT ENDING SCB INTO BUFFER @VA03347 04355000 MVI 3(R8),X'00' PUT ENDING RCB INTO BUFFER @VA03347 04356000 MVI 4(R8),XETB PUT ETB INTO BUFFER @VA03347 04357000 B GENDREC GO TO PROCESS END OF RECORD @VA03347 04358000 EJECT 04359000 *---------------------------------------------------------------------* 04360000 * * 04361000 * DECOMPRESS A TP BUFFER * 04362000 * * 04363000 *---------------------------------------------------------------------* 04364000 SPACE 1 04365000 GDECOMP DS 0H PROCESS AN SCB 04366000 MVC GSCB(1),2(R8) SET SCB 04367000 NI GSCB,X'7F' TURN OFF HIGH-BIT 04368000 BZ GENDREC END-OF-RECORD 04369000 MVC GSCBCK(1),GSCB GET SCB TO TEST @VA06382 04370000 TM GSCBCK,X'40' IS IT CHAR STRING @VA06382 04371000 BO SCBCK YES CHANGE STRIP COUNT @VA06382 04372000 NI GSCBCK,X'1F' STRIP THE INDICATOR BITS @VA06382 04373000 SCCK2 SR R6,R6 CLEAR R6 @VA06382 04374000 IC R6,GSCBCK GET STRING CONTROL BYTE @VA06382 04375000 AR R6,R5 ADD TANK COUNT @VA06382 04376000 S R6,GTANK SUBTRACT START ADDRESS @VA06382 04377000 CH R6,TNKEND WILL IT GO OVER TANK END @VA06382 04378000 BH COMPERR YES ERROR DONT DO IT @VA06382 04379000 TM GSCB,X'40' IS THIS A CHAR STRING... 04380000 BZ GPROP BR IF NOT 04381000 NI GSCB,X'3F' TURN OFF STRING BIT 04382000 SR R6,R6 CLEAR OUT R6 FOR IC 04383000 IC R6,GSCB GET STRING CONTROL BYTE 04384000 EX R6,GMVC1 MOVE BUFFER 04385000 AR R8,R6 COUNT INPUT STRING 04386000 GCONT EQU * 04387000 AR R5,R6 COUNT OUTPUT STRING 04388000 AR R8,R15 COUNT SCB 04389000 B GDECOMP CONTINUE WITH RECORD 04390000 SPACE 1 04391000 GPROP DS 0H PROPGATION REQUIRED 04392000 TM GSCB,X'20' IS THIS BLANKS... 04393000 BZ GBLANKS BR IF YES 04394000 NI GSCB,X'1F' NO .. REMOVE INDICATOR 04395000 MVC TANKDATA(1),3(R8) SET SAMPLE CHARACTER 04396000 SR R6,R6 CLEAR OUT R6 FOR IC 04397000 IC R6,GSCB GET STRING CONTROL BYTE 04398000 BCTR R6,0 REDUCE BY ONE FOR TANKDATA @VA06381 04399000 LTR R6,R6 IS MOVE FOR 1 BYTE ONLY @VA07697 04400000 BZ GDECONE YES,DONT DECREMENT MORE @VA07697 04401000 BCTR R6,0 REDUCE BY ONE FOR MOVE @VA06381 04402000 EX R6,GMVC2 PROPAGATE COUNT (+2) 04403000 AR R8,R15 COUNT SAMPLE CHAR 04404000 LA R6,2(0,R6) CORRECT CHAR COUNT @VA06381 04405000 B GCONT AND ENTER FLOW 04406000 GDECONE EQU * EXPAND ONE BYTE ONLY @VA07697 04407000 AR R8,R15 COUNT SAMPLE CHAR @VA07697 04408000 LA R6,1(0,R6) CORRECT CHAR COUNT @VA07697 04409000 B GCONT CONTINUE PROCESSING @VA07697 04410000 SPACE 1 04411000 GBLANKS DS 0H BLANK PROPAGATION REQUIRED 04412000 MVI TANKDATA,C' ' SET BLANK SAMPLE 04413000 SR R6,R6 CLEAR OUT R6 FOR IC 04414000 IC R6,GSCB GET STRING CONTROL BYTE 04415000 BCTR R6,0 REDUCE BY ONE FOR MOVE @VA06381 04416000 EX R6,GMVC2 PROPAGATE BLANKS 04417000 AR R6,R15 CORRECT CHAR COUNT @VA06381 04418000 B GCONT ENTER FLOW 04419000 SPACE 1 04420000 GMVC1 MVC TANKDATA(0),3(R8) TO BE EXECUTED BY ABOVE CODE 04421000 GMVC2 MVC TANKDATA+1(0),TANKDATA TO BE EXECUTED BY ABOVE CODE 04422000 COMPERR DS 0H HERE ON COMPRESSION ERROR @VA06382 04423000 MSG 937,AXSLINK WRITE ERROR MSG @VA06382 04424000 B EOJ GO TO END THIS @VA06382 04425000 SCBCK NI GSCBCK,X'3F' USE THIS STRIP COUNT @VA06382 04426000 B SCCK2 GO BACK TO TEST LENGTH @VA06382 04427000 GSCBCK DC H'0' SCB CHECK CHAR @VA06382 04428000 TNKEND DC X'00D0' TOTAL TANK LENGTH @VA06382 04429000 EJECT 04430000 GENDREC DS 0H END OF LOGICAL RECORD 04431000 L R6,GTANK TANK ADDR 04432000 SR R5,R6 FROM END PTR 04433000 DROP R5 04434000 USING TANKDSEC,R6 GET TANKDSEC ADDRESSABILTIY 04435000 STH R5,TANKCNT SET COUNT IN TANK 04436000 LA R5,TCTTANK-TCTDSECT TANK CHAIN DISPLACEMENT 04437000 AR R5,R13 R5 = ABSOLUTE TANK CHAIN PTR 04438000 GENDREC1 EQU * 04439000 CLC 0(4,R5),=F'0' IS IT THE LAST? 04440000 BE GENDREC2 YES 04441000 L R5,0(0,R5) GET THE NEXT ONE 04442000 B GENDREC1 AND COMPARE 04443000 SPACE 1 04444000 GENDREC2 EQU * 04445000 ST R6,0(0,R5) CHAIN THIS ONE TO IT 04446000 MVC 0(4,R6),=F'0' SET NEW FORWARD ZERO 04447000 A R8,=F'3' ADD IN THREE 04448000 LH R5,TCTTNKLM LIMIT AND COUNT 04449000 AR R5,R15 INCREMENT COUNT 04450000 STH R5,TCTTNKLM AND RESET 04451000 L R5,TCTCOM GET COMMUTATOR ENTRY 04452000 MVI 1(R5),OPEN OPEN PROCESSOR GATE 04453000 L R6,TCTBUFER CURRENT BUFFER ADDR 04454000 CLC TCTRCBR,0(R8) IS NEXT RECORD SAME 04455000 BNE GSWITCH BR IF NO 04456000 SR R8,R6 REDUCE TO DATA DISPLACEMENT 04457000 STH R8,BUFCOUNT-BUFDSECT(0,R6) 04458000 B GTTANK AND CONTINUE 04459000 SPACE 1 04460000 GSWITCH DS 0H DIFFERENT RCB ENCOUNTERED 04461000 NI BUFSYNSW,255-GDQBUFS ALLOW DEQUEUING TRY 04462000 MVC TCTBUFER,0(R6) UPDATE CHAIN 04463000 BAL R14,GASSIGN GO RE-ASSIGN BUFFER 04464000 LH R8,TCTBUFLM BUFFER LIMIT AND COUNT 04465000 BCTR R8,0 REDUCE COUNT 04466000 STH R8,TCTBUFLM AND RESET 04467000 CLC TCTBUFCT,TCTBUFLM IS ANOTHER BUFFER REQUIRED 04468000 BNL GSERVICE BR IF NO TO CONTINUE 04469000 OC $FCSOUT,TCTFCS SHOW NEXT BUFFER PERMITTED 04470000 B GSERVICE AND CONTINUE 04471000 EJECT 04472000 *---------------------------------------------------------------------* 04473000 * * 04474000 * ASSIGN A TP BUFFER TO A TCT * 04475000 * * 04476000 * R6=BUFFER ADDRESS , R8=PTR TO CURRENT RCB IN BUFFER * 04477000 * * 04478000 *---------------------------------------------------------------------* 04479000 SPACE 1 04480000 GASSIGN DS 0H ASSIGN BUFFER TO CORRECT TCT 04481000 ST R13,GAST PRESERVE TCT REG 04482000 LA R13,$TCT1 START OF TCT'S 04483000 GASNEXT DS 0H * 04484000 CLC TCTRCBR,0(R8) COMPARE RCB'S 04485000 BE GASIT BR IF FOUND 04486000 ICM R13,B'1111',TCTNEXT TO NEXT AND CHECK FOR END 04487000 BNZ GASNEXT BR IF NO TO CONTINUE 04488000 CLI 0(R8),0 IS THIS A NULL BUFFER 04489000 BNE GCTLCHK BR IF NO 04490000 SPACE 1 04491000 GIGNORIT DS 0H * 04492000 MVC 0(4,R6),$BUFPOOL GET FIRST FREE OFF QUEUE 04493000 ST R6,$BUFPOOL MAKE THIS ONE THE FIRST 04494000 TM WCTSTAT,TCTREL ARE MESSAGES QUEUED? 04495000 BNO GIGNORT1 NO CONTINUE 04496000 OI $MSGCOM+1,OPEN OPEN THE MSG GATE 04497000 B GASRET DONT CHECK ANYTHING ELSE TILL LATER 04498000 SPACE 1 04499000 GIGNORT1 EQU * 04500000 CLI RCTWFB,X'FF' READER WAITING? 04501000 BNE GASRET NO - RETURN 04502000 OI $RCOMM1+1,OPEN OPEN THE READER GATE 04503000 B GASRET AND RETURN 04504000 SPACE 1 04505000 GCTLCHK DS 0H TEST FOR CONTROL RECORD 04506000 CLI 0(R8),X'F0' GENERAL CONTROL RECORD? 04507000 BE GCTLCHK1 YES GO PROCESS IT 04508000 TM 0(R8),15 IS RECORD TYPE = 0000 04509000 BNZ GIGNORIT NO...SKIP RECORD(AND BUFFER) 04510000 GCTLCHK1 EQU * 04511000 LA R13,$CTLTCT TYPE IS CTL...LOAD TCT 04512000 EJECT 04513000 GASIT DS 0H TCT FOUND 04514000 SR R8,R6 R8 = DATA DISPLACEMENT 04515000 STH R8,BUFCOUNT-BUFDSECT(0,R6) SAVE 04516000 LA R8,TCTBUFER-TCTDSECT ACTUAL DISP 04517000 AR R8,R13 ACTUAL ADDRESS 04518000 GASIT1 EQU * 04519000 CLC 0(4,R8),=F'0' IS IT THE LAST 04520000 BE GASIT2 YES 04521000 L R8,0(0,R8) GET THE NEXT ONE 04522000 B GASIT1 AND COMPARE 04523000 SPACE 1 04524000 GASIT2 EQU * 04525000 ST R6,0(0,R8) CHAIN THIS ONE TO IT 04526000 MVC 0(4,R6),=F'0' SET NEW FORWARD ZERO 04527000 LH R8,TCTBUFLM LIMIT AND COUNT 04528000 AH R8,=H'1' COUNT THIS 04529000 STH R8,TCTBUFLM AND RESET 04530000 OI TCTSTAT,TCTACT START ACTION 04531000 CLC TCTBUFCT,TCTBUFLM ARE ENOUGH BUFFERS HERE 04532000 BL GASRET BR IF MORE BUFFERS NEEDED 04533000 OC $FCSOUT,TCTFCS MODIFY FCS 04534000 XC $FCSOUT,TCTFCS TO STOP THIS STREAM 04535000 GASRET DS 0H RETURN ENTRY 04536000 L R13,GAST AND RETURN 04537000 BR R14 TO CALLER 04538000 SPACE 1 04539000 GWAIT DS 0H PREPARE FOR EXIT 04540000 NI BUFSYNSW,255-GDQBUFS OPEN DEQUEUE GATE 04541000 B $TPGETCM+4 EXIT 04542000 SPACE 1 04543000 GINBUF DC A(0) INPUT BUFFER ADDR 04544000 GBUFPTR DC A(0) INPUT BUFFER POINTER 04545000 GTANK DC A(0) TANK ADDR 04546000 GAST DC A(0) TEMP STORAGE 04547000 GCTL DC H'0' WORK SPACE 1 04548000 GSCB DC X'00' WORKING STRING CONTROL BYTE 04549000 DROP R6,R13 DISCONTINUE TANK REG 04550000 EJECT 04551000 *---------------------------------------------------------------------* 04552000 * * 04553000 * $GETTNK ROUTINE TO GET A TANK FOR PROCESSOR * 04554000 * * 04555000 *---------------------------------------------------------------------* 04556000 SPACE 1 04557000 USING TCTDSECT,TCTR GET TCT ADDRESSABILITY 04558000 $GETTNK DS 0H 04559000 ST R14,TCTSAV1 SAVE USER REG FOR POSSIBLE WAIT 04560000 MVC TCTENTY(2),OACN2 SET REENTRY FOR POSSIBLE WAIT 04561000 OLOC2 EQU * 04562000 CLC TCTTANK,=F'0' ARE WE EMPTY? 04563000 BE $CLOSTCT YES 04564000 L R8,TCTTANK GET FIRST BUFFER ADDR 04565000 MVC TCTTANK(4),0(R8) REMOVE THIS ONE FROM CHAIN 04566000 LH R6,TCTTNKLM REDUCES COUNT IN TNKCT 04567000 BCTR R6,0 DOWN BY ONE 04568000 STH R6,TCTTNKLM AND REPLACE COUNT 04569000 OI TCTSTAT,TCTACT SIGNAL WE HAVE RECEIVED TANK 04570000 MVI $TPGETCM+1,OPEN OPEN THE GATE TO TPGET ROUTINE 04571000 L R14,TCTSAV1 PICK UP USER 04572000 BR R14 RETURN TO HIM 04573000 SPACE 1 04574000 * 04575000 * $CLOSTCT ROUTINE TO CLOSE GATE AND RETURN 04576000 * 04577000 $CLOSTCT DS 0H 04578000 L R6,TCTCOM PICK UP COMMUTATOR 04579000 MVI 1(R6),CLOSE CLOSE GATE 04580000 B 4(R6) RETURN TO COMMUTATOR 04581000 SPACE 1 04582000 OACN2 DC S(OLOC2) RENTRY POINT 04583000 EJECT 04584000 *---------------------------------------------------------------------* 04585000 * * 04586000 * $TPOPEN -- OPEN A STREAM * 04587000 * * 04588000 *---------------------------------------------------------------------* 04589000 SPACE 1 04590000 $TPOPEN DS 0H 04591000 ST R14,TSAVA SAVE CALLER'S 04592000 ST R8,TSAVB REGS 04593000 MVC TTANK+TANKSRCB-TANKDSEC(1),TANKRCB-TANKDSEC(R8) SET FCN 04594000 L R8,TANKCON FOR $TPPUT 04595000 BAL R14,$TPPUT GO PUT RECORD 04596000 L R8,TSAVB CALLER'S 04597000 L R14,TSAVA REGS 04598000 BR R14 RETURN TO CALLER 04599000 SPACE 1 04600000 * DUMMY TANK 04601000 TTANK DC A(0) CHAIN 04602000 DC X'90' RCB FOR FUNCTION CTL RECORD 04603000 DC X'00' USER'S SRCB (FUNCTION TYPE) 04604000 DC H'0' TANK COUNT 04605000 TSAVA DC A(0) SAVE AREA 04606000 TSAVB DC A(0) SAVE AREA 04607000 TANKCON DC A(TTANK) CONSTANT 04608000 EJECT 04609000 *. 04610000 * 04611000 * ENTRY NAME - 04612000 * 04613000 * COMSUP 04614000 * 04615000 * FUNCTION - 04616000 * 04617000 * THIS ROUTINE IS RESPONSIBLE FOR ALL I/O ON THE 04618000 * COMMUNICATIONS LINE. IT DEQUEUES TP BUFFERS FROM 04619000 * $OUTBUF FOR TRANSMISSION AND QUEUES RECEIVED TP BUFFERS 04620000 * ONTO THE $INBUF QUEUE FOR DEBLOCKING BY $TPGET. 04621000 * 04622000 * CALLS TO OTHER ROUTINES - 04623000 * 04624000 * DMTIOMRQ - TO INITIATE AN I/O OPERATION 04625000 * 04626000 * OPERATION - 04627000 * 04628000 * 1. CLOSE THE LINE INTERRUPT ENTRY IN THE COMMUTATOR 04629000 * TABLE AND CHECK CSW FOR ERRORS. 04630000 * 04631000 * 2. CHECK BSC CONTROL CHARACTERS ON THE BUFFER RECEIVED 04632000 * TO DETERMINE THE KIND OF RESPONSE FROM THE LINE 04633000 * 04634000 * 3. PROCESS AN ACK RESPONSE BY TRYING TO OBTAIN AN OUTPUT 04635000 * BUFFER AND WRITING IT TO THE LINE. 04636000 * 04637000 * 4. PROCESS STX RESPONSE BY VERIFYING THE BSC CONTROL 04638000 * CHARACTERS AND QUEUEING THE INPUT BUFFER FOR DEBLOCKING 04639000 * BY $TPGET. 04640000 * 04641000 * 5. PROCESS NAK RESPONSE REST THE BSC LEADER CHARACTER AND RE- 04642000 * WRITE THE BUFFER. 04643000 * 04644000 * RESPONSES - 04645000 * 04646000 * NONE 04647000 * 04648000 * ERROR MESSAGES - 04649000 * 04650000 * NONE 04651000 * 04652000 *. 04653000 EJECT 04654000 USING LINKTABL,R6 GET LINKTABLE ADDRESSABILITY 04655000 COMSUP EQU * 04656000 $INTRUPT MVI $COMCOM+5,CLOSE 04657000 TM BUFSYNSW,$COMBUSY IS THERE COMMUNICATIONS ACTIVE? 04658000 BO CEXIT NO 04659000 STM R13,R15,CREGS SAVE INTERRUPTED REGS 04660000 L R13,CBUFFER GET CURRENT BUFFER ADDR 04661000 TM BUFSYNSW,CUWFAKE DUMMY I/O 04662000 BO CWRTSIO YES 04663000 TM ADACSW+5,X'BF' TEST FOR UNEXPECTED ERRORS 04664000 BNZ CBADERR BR IF ANY 04665000 TM ADACSW+4,X'F3' TEST OTHER UNUSUAL ENDINGS 04666000 BNZ CERROR BR IF ANY 04667000 * CHANNEL-END , DEVICE-END ASSUMED 04668000 EJECT 04669000 SPACE 3 04670000 $ENDREAD DS 0H EXTERNAL ENTRY POINT 04671000 SPACE 1 04672000 USING BUFDSECT,R13 * 04673000 CNOLOGAL DS 0H ENTRY TO SKIP LOGGING EVERYTHING 04674000 MVC CCWC+6(2),RDCOUNT RESET BUFFER SIZE @VA08725 04675000 TM SMLSYS,MASTER ARE WE IN HOST MODE? 04676000 BNO CNOLOG0 NO CONTINUE 04677000 CLC BUFSTART(2),=AL1(XSOH,XENQ) DID WE GET THE START 04678000 BE CACKED YES TREAT LIKE ACK 04679000 CNOLOG0 EQU * 04680000 BAL R14,TRTRAN LOG THE TRANSACTION 04681000 MVC CRESP,BUFSTART GET FIRST RESPONSE BYTE 04682000 XC TOCNT(2),TOCNT CLEAR TIMEOUT COUNTER @VA05950 04683000 CLI CRESP,XDLE IS IT DLE LEADER... 04684000 BNE CNOLOG1 BR IF NO 04685000 MVC CRESP,BUFSTART+1 YES... GET REAL RESPONSE 04686000 CNOLOG1 EQU * 04687000 CLI CRESP,XSOH IS THIS NON-XPARENT LEADER... 04688000 BE CINBUF BR IF YES TO PROCESS TEXT 04689000 CLI CRESP,XSTX IS THIS DATA 04690000 BE CINBUF BR IF YES TO PROCESS 04691000 CLI CRESP,XACK0 IS THIS WRITE ACKNOWLEDGEMENT 04692000 BE CACKED BR IF YES 04693000 CLI CRESP,XNAK WERE WE NAK'ED 04694000 BE CNAKED BR IF YES 04695000 B CRESPBAD UNKNOWN RESPONSE RECEIVED 04696000 EJECT 04697000 * 04698000 * POSITIVE ACKNOWLEDGEMENT OF LAST WRITE RECEIVED 04699000 * 04700000 SPACE 3 04701000 CACKED DS 0H ACKNOWLEDGEMENT WAS ACK 04702000 TM BUFSTAT,BUFTONAK+BUFNAK NAK SENT AFTER T/O @VA08636 04703000 BO CNAKNAK NAK AFTER T/O ON DATA @VA08636 04704000 NI BUFSTAT,X'FF'-BUFTONAK RESET T/O INDICATOR @VA08636 04705000 NI $FCSIN,255-X'40' TURN OFF WAIT-A-BIT 04706000 OI BUFSYNSW,CACKSW SET ACK RECEIVED 04707000 CWRTOK DS 0H 04708000 TM BUFSTAT,BUFFAKE IS THIS A DUMMY BUFFER 04709000 BO CWRTNEXT BR IF YES 04710000 MVI BUFSTAT,0 RESET STATUS BYTE 04711000 MVC 0(4,R13),$BUFPOOL GET FIRST FREE OFF QUEUE 04712000 ST R13,$BUFPOOL MAKE THIS ONE THE FIRST 04713000 TM WCTSTAT,TCTREL IS THE MSG PROC WAITING? 04714000 BNO CWRTOK1 NO CONTINUE 04715000 OI $MSGCOM+1,OPEN OPEN THE MSG GATE 04716000 B CWRTNEXT AND CONTINUE 04717000 SPACE 04718000 CWRTOK1 EQU * 04719000 CLI RCTWFB,X'FF' IS THE READER WAITING? 04720000 BNE CWRTNEXT NO - CONTINUE 04721000 OI $RCOMM1+1,OPEN OPEN THE READER GATE 04722000 CWRTNEXT EQU * ENTRY TO START NEXT WRITE 04723000 TM BUFSYNSW,CACKSW WAS AN ACK RECEIVED? 04724000 BO CNOD YES 04725000 BAL R15,CSETCOM MAKE A COMMUTATOR PASS 04726000 BAL R15,CSETCOM AND ANOTHER 04727000 CNOD EQU * ACK BYPASS 04728000 NI BUFSYNSW,255-CACKSW RESET SWITCH 04729000 CYCLE EQU * COMMUTATOR CYCLE POINT 04730000 TM $FCSIN,X'40' IS WAIT-A-BIT SET 04731000 BO CWAITBIT BR IF YES 04732000 TM SMLSYS,MASTER HOST MODE? @VA03301 04733000 BNO CYCLE1 NO...CONTINUE CHECK @VA03301 04734000 MVC CFCSTEMP(2),$FCSIN MOVE RECEIVED TO TEMP AREA @VA03301 04735000 NC CFCSTEMP(2),CFCSSTD SETUP FOR TEST @VA03301 04736000 XC CFCSTEMP(2),CFCSSTD TEST AGAINST STANDARD @VA03301 04737000 BC 4,CWAITBIT STREAM IS NEGATED @VA03301 04738000 CYCLE1 EQU * @VA03301 04739000 NI BUFSYNSW,255-$TPPNONE RESET BUFFERING STOP 04740000 L R6,SMLLINK GET LINK TABLE ENTRY ADDR 04741000 TM LFLAG,LHOLD ARE ARE HELD? 04742000 BO CRESPOND SEND RESPONSE @VA05952 04743000 CLC $OUTBUF,=F'0' ARE WE EMPTY 04744000 BE CRESPOND YES 04745000 L R13,$OUTBUF GET FIRST BUFFER ADDR 04746000 MVC $OUTBUF(4),0(R13) REMOVE THIS ONE FROM CHAIN 04747000 EJECT 04748000 SPACE 4 04749000 CSTNDWRT DS 0H ENTRY FOR BUFFER WRITE WITH BCB 04750000 MVC BUFSTART,XSTXSEQ SET START OF TEXT HEADER 04751000 OI BUFSTAT,BUFTEXT SHOW TEXT BUFFER 04752000 MVC CSETBCB(1),CBCBCNTO BCB FOR CURRENT BUFFER 04753000 LH R15,CBCBCNTO-1 GET CURRENT COUNT 04754000 AH R15,=H'1' INCREMENT TO NEXT 04755000 STH R15,CBCBCNTO-1 AND SAVE 04756000 NI CBCBCNTO,X'80'+15 MODULO 16 04757000 B CNWRITE GO WRITE BUFFER 04758000 SPACE 3 04759000 * 04760000 * WAIT-A-BIT SEQUENCE RECEIVED 04761000 * 04762000 SPACE 1 04763000 CWAITBIT DS 0H * 04764000 OI BUFSYNSW,$TPPNONE STOP ALL BUFFERING 04765000 B CRESPOND GO RESPOND 04766000 EJECT 04767000 SPACE 3 04768000 CINBUF DS 0H * 04769000 TM BUFSTAT,BUFFAKE IS THIS A DUMMY BUFFER? @VA08779 04770000 BO WAITON YES, NO CALC REQUIRED @VA08779 04771000 CLI BUFDATA,X'E0' SEE IF HE IS RESETING 04772000 BE CBCBRSET AND GO TRY TO RESET THINGS 04773000 LA R15,BUFSTART-1 GET START OF ACTUAL BUFFER 04774000 A R15,TPBUFSIZ POSITION TO END OF BUFFER 04775000 SH R15,ADACSW+6 SUBSTACT OUT RESIDUAL COUNT 04776000 CLI 0(R15),XETB WAS ENDING SEQUENCE CORRECT 04777000 BNE CRESPBAD BR IF YES TO LOG AND NAK 04778000 WAITON EQU * NO CALC FOR BUFFER REQ @VA08779 04779000 MVC $FCSIN,BUFFCS SET NEW FUNCTION CONTROL 04780000 SPACE 1 04781000 * VERIFY BLOCK CONTROL BYTE COUNT 04782000 MVC CBCB(1),BUFBCB GET BCB COUNT 04783000 CLC CBCBCNTI(1),CBCB DOES RECEIVED MATCH EXPECTED 04784000 BNE CBCBCHEK BR IF NO 04785000 LH R15,CBCBCNTI-1 GET CURRENT COUNT 04786000 AH R15,=H'1' TO NEXT EXPECTED 04787000 STH R15,CBCBCNTI-1 AND RESET 04788000 NI CBCBCNTI,X'80'+15 MOLULO 16 04789000 SPACE 1 04790000 CBCBOK DS 0H ENTRY FROM IGNORE 04791000 TM BUFSTAT,BUFFAKE IS THIS DUMMY BUFFER 04792000 BO CWRTOK BR IF YES TO IGNORE 04793000 CLI BUFDATA,X'00' IS IT A NULL BUFFER? 04794000 BE CWRTOK YES..ALL DONE 04795000 CLC BUFDATA+2(9),SIGNOFF SIGNOFF CARD? @VA08191 04796000 BE DSBLOFF YES, KILL THE LINK @VA08191 04797000 CLI BUFDATA+1,C'B' Q. IF SIGN-OFF RECORD FROM C 04798000 BNE CNOTOFF IF NO CONTINUE 04799000 DSBLOFF EQU * ISSUE DISABLE CCW @VA08191 04800000 MVI BUFDATA,X'91' MAKE LOOK LIKE WTO FROM CENTRAL 04801000 B EOJ GO TERMINATE IMMEDIATELY @VA04173 04802000 SPACE 1 04803000 CNOTOFF EQU * 04804000 MVI $TPGETCM+1,OPEN OPEN TPGETS GATE 04805000 MVI BUFSTAT,0 RESET BUFFER STATUS BITS 04806000 LA R15,$INBUF QUEUE CONTROL WORD 04807000 CINBUF1 EQU * 04808000 CLC 0(4,R15),=F'0' IS IT THE LAST 04809000 BE CINBUF2 YES 04810000 L R15,0(0,R15) GET THE NEXT ONE 04811000 B CINBUF1 AND COMPARE 04812000 SPACE 1 04813000 CINBUF2 EQU * 04814000 ST R13,0(0,R15) CHAIN THIS ONE TO IT 04815000 MVC 0(4,R13),=F'0' SET NEW FORWARD ZERO 04816000 B CWRTNEXT AND CONTINUE XMISSION 04817000 EJECT 04818000 * 04819000 * RECEIVED BCB CHECK COUNT NOT CORRECT 04820000 * 04821000 CBCBCHEK DS 0H DETERMINE DAMAGE 04822000 TM CBCB,BCBIGNRE IS THE IGNORE BIT ON 04823000 BO CBCBOK BR IF YES 04824000 TM CBCB,BCBRESET IS THIS A RESET REQUEST 04825000 BZ CBCBBAD BR IF NO 04826000 MVN CBCBCNTI(1),CBCB YES... DO IT 04827000 B CBCBOK AND PROCESS RECORD 04828000 SPACE 1 04829000 CBCBBAD DS 0H BLOCK COUNTS DO NOT AGREE 04830000 MVC CTEMP+1(1),CBCB ISOLATE RECEIVED CNT 04831000 LH R15,CBCBCNTI-1 GET EXPECTED CNT 04832000 SH R15,CTEMP LESS RECEIVED 04833000 BP CBCBBAD1 BR IF TOO LOW 04834000 AH R15,=H'16' MAKE DIFFERENCE POSITIVE 04835000 CBCBBAD1 EQU * 04836000 CH R15,CMAXDUP IS DIFFERENCE REASONABLE 04837000 BH CBLKLOST BR IF NO 04838000 B CWRTOK IGNORE BLOCK 04839000 SPACE 2 04840000 CBLKLOST DS 0H ONE OR MORE BLOCKS ARE LOST 04841000 MVN CLOSTBCB,CBCB SET RECEIVED BLOCK COUNT 04842000 MVN CLSTSRCB,CBCBCNTI SET EXPECTED BLOCK COUNT 04843000 MVC BUFCOUNT(CLOSTEND-CLOSTBLK),CLOSTBLK SET BAD BLOCK 04844000 MVC CSETBCB(1),CLOSTBCB SET RESTORE BCB INSTRUCTION V03.1 04845000 B CNWRITE GO TELL OTHER SIDE ABOUT BAD BCB 04846000 EJECT 04847000 SPACE 3 04848000 CRESPOND DS 0H ENTRY TO RESPOND 04849000 L R6,SMLLINK GET LINK TABLE ENTRY ADDR 04850000 CLC $BUFPOOL,=F'0' ARE WE EMPTY? 04851000 BE CSTOPIN YES 04852000 L R13,$BUFPOOL GET FIRST BUFFER ADDR 04853000 MVC $BUFPOOL(4),0(R13) REMOVE THIS ONE FROM CHAIN 04854000 B CBUFGOTN BR IF GOTTEN 04855000 SPACE 1 04856000 CSTOPIN DS 0H ENTRY TO STOP ALL INPUT 04857000 LA R13,CDUMMY USE DUMMY BUFFER 04858000 MVI BUFDATA,0 SET NULL BUFFER RCB 04859000 MVI BUFSTAT,BUFFAKE FORCE STATUS TO DUMMY 04860000 B CSTNDWRT GO DO NORMAL WRITE 04861000 SPACE 1 04862000 CBUFGOTN DS 0H 04863000 MVI BUFDATA,0 SET NULL BUFFER RCB 04864000 MVC BUFCOUNT,=AL2(CDUMEND-CDUMSTRT) SET WRITE COUNT 04865000 CLC CFCSOUT,$FCSOUT HAS FCS BEEN CHANGED 04866000 BNE CSTNDWRT BR IF YES TO DO NORMAL WRITE 04867000 MVC BUFSTART,XACKSEQ SETUP STANDARD SEQUENCE 04868000 CSENDRES DS 0H * 04869000 OI BUFSTAT,BUFRESP SHOW RESPONSE BUFFER 04870000 B CNWRITE AND GO WRITE 04871000 EJECT 04872000 * 04873000 * A NEGATIVE RESPONSE RECEIVED 04874000 * 04875000 SPACE 3 04876000 CNAKED DS 0H PREPARE TO RETRANSMIT 04877000 TM BUFSTAT,BUFNAK WERE WE SENDING A NAK 04878000 BO CNAKNAK BR IF YES 04879000 MVC BUFSTART(10),CBUFLAST RESET START OF BUFFER @VA05474 04880000 TM BUFSTAT,BUFTEXT WAS THIS A TEXT BUFFER 04881000 BO CREWRITE BR IF YES TO RETRY 04882000 MVC BUFSTART(2),XACKSEQ SETUP STANDARD SEQUENCE @VA05470 04883000 B CWRTSIO AND GO WRITE IT 04884000 SPACE 1 04885000 CNAKNAK DS 0H OUR NAK WAS NAK'ED 04886000 TM BUFSTAT,BUFTEXT WAS ORIGINAL BUFFER TEXT... 04887000 BZ CWRTOK NO...FORGET IT 04888000 * YES...PREPARE TO RESEND 04889000 MVC BUFSTART,XSTXSEQ RESET TEXT LEADERS 04890000 NI BUFSTAT,X'FF'-BUFTONAK-BUFNAK-BUFRESP RESET BITS@VA08636 04891000 B CNWRITE WRITE BUFFER AGAIN 04892000 SPACE 5 04893000 * 04894000 * UNKNOWN RESPONSE ... RESEND LAST DATA 04895000 * 04896000 CRESPBAD DS 0H 04897000 SPACE 3 04898000 * 04899000 * SEND A NEGATIVE RESPONSE 04900000 * 04901000 CSENDNAK DS 0H ENTRY 04902000 MVC BUFSTART,XNAKSEQ SET NAK SEQUENCE 04903000 OI BUFSTAT,BUFRESP+BUFNAK SHOW NAK RESPONSE 04904000 B CNWRITE AND GO WRITE IT 04905000 EJECT 04906000 * 04907000 * A RESET BCB RECEIVED FROM OTHER END 04908000 * THE PROCEDURE USED HERE IS TO TREAT A RESET 04909000 * AS A NAK REPLACE THE FIRST 9 BYTES OF BUFFER 04910000 * AND RETRANSMIT WITH CORRECTED BCB COUNT 04911000 * 04912000 SPACE 2 04913000 CBCBRSET DS 0H 04914000 *********************************************************************** 04915000 * A BCB SEQUENCE CHECK WILL MEAN THAT A BLOCK OF DATA HAS BEEN LOST 04916000 * AND INTEGRITY OF THE DATA IS NOW QUESTIONABLE. THE ONLY RECOURSE 04917000 * TO ENSURE THE ENTIRE DATA SET IS COMPLETE IS TO TERMINATE THE 04918000 * LINK AND HAVE IT STARTED AGAIN WITH THE REMOTE OPERATOR FORWARD 04919000 * SPACE TO THE POINT OF BLOCK CHECK AND RESUMMING THE DATA SET AGAIN 04920000 *********************************************************************** 04921000 B EOJ TERMINATE LINK NOW @VA08633 04922000 EJECT 04923000 * 04924000 * COMSUP IS EXITING WITHOUT I/O ACTIVE 04925000 * PREPARE FOR RE-ENTRY THROUGH COMUTATOR 04926000 * 04927000 SPACE 3 04928000 CSETCOM DS 0H * 04929000 MVI $COMCOM+1,OPEN OPEN GATE 04930000 OI BUFSYNSW,$COMBUSY SHOW NO ACTIVITY 04931000 STM R13,R15,CRETREGS SAVE SOME REGISTERS 04932000 B CREXIT AND RETURN TO INTERRUPTED LOC 04933000 SPACE 1 04934000 $COMSUP DS 0H 04935000 MVI $COMCOM+1,CLOSE CLOSE COMUTATOR ENTRY 04936000 LM R13,R15,CRETREGS RESTORE 04937000 MVC $COMEXIT+1(3),=AL3($COMCOM+4) SET EXIT TO COMUTATOR 04938000 NI BUFSYNSW,255-$COMBUSY ALLOW COMMUNICATIONS INTERRUPTS 04939000 BR R15 RE-ENTER COMSUP 04940000 EJECT 04941000 SPACE 3 04942000 CNWRITE DS 0H 04943000 LA R15,BUFSTART TO XMISSION POINT 04944000 ST R15,CCWA INTO CCW 04945000 MVI CCWA,WRITE RESET OP 04946000 ST R15,CCWC SET RETURN DATA ADDR 04947000 MVI CCWC,READ RESET OP 04948000 MVC CCWA+6(2),BUFCOUNT SET WRITE COUNT 04949000 MVI CCWA+4,XCHN SET PROPER CCW CHAINING 04950000 ST R13,CBUFFER SAVE BUFFER ADDR 04951000 MVI CCWB,WRITE RESET OP FOR ENDING SEQ 04952000 TM BUFSTAT,BUFRESP IS THIS JUST A RESPONSE 04953000 BZ CREWRITE BR IF NO 04954000 MVI CCWA+4,CC+SILI SET COMMAND CHAINING 04955000 MVC CCWA+6(3),=X'000203' SET COUNT AND 2ND CCW OP 04956000 B CWRTSIO GO START WRITE 04957000 SPACE 1 04958000 CREWRITE DS 0H ENTRY TO RETRY WRITE 04959000 MVC CFCSOUT,$FCSOUT SAVE LAST FCS SENT 04960000 MVC BUFFCS,$FCSOUT SET CURRENT FCS 04961000 MVC BUFBCB(1),CSETBCB SET BCB INTO BUFFER 04962000 MVC COLDRCB(1),BUFDATA SAVE RCB THAT IS SENT 04963000 TM BUFSTAT,BUFFAKE IS THIS A DUMMY BUFFER 04964000 BZ CWRTSIO BR IF NO 04965000 OI BUFFCS,X'40' YES...SET WAIT-A-BIT 04966000 MVC CCWC+6(2),DUMCOUNT SET READ CNT FOR W/BIT @VA07451 04967000 SPACE 1 04968000 CWRTSIO DS 0H START THE WRITE 04969000 MVC CBUFLAST(10),BUFSTART SAVE INCASE OF RESET 04970000 NI BUFSYNSW,255-CUWFAKE MAKE SURE DUMMY READ NOT ON 04971000 BAL R15,$SIO ISSUE THE I/O 04972000 DC AL4(CCWS) FOR THIS CCW STRING @VA03340 04973000 SPACE 3 04974000 * 04975000 * INTERRUPT EXIT ROUTINE 04976000 * 04977000 SPACE 3 04978000 CREXIT DS 0H 04979000 LM R13,R15,CREGS RESTORE INTERRUPTED REGS 04980000 CEXIT DS 0H 04981000 L R4,$COMEXIT GET RETURN POINT 04982000 BR R4 AND RETURN 04983000 EJECT 04984000 *. 04985000 * 04986000 * ENTRY NAME - 04987000 * 04988000 * CERROR 04989000 * 04990000 * FUNCTION - 04991000 * 04992000 * THIS ROUTINE IS RESPONSIBLE FOR ANALYZING ALL ERRORS ON 04993000 * THE COMMUNICATIONS LINE. THE APPROPRIATE CORRECTIVE 04994000 * ACTIVE IS TAKEN DEPENDING ON THE TYPE OF ERROR. 04995000 * 04996000 * CALLS TO OTHER ROUTINES - 04997000 * 04998000 * NONE 04999000 * 05000000 * OPERATION - 05001000 * 05002000 * 1. DETERMINE THE TYPE OF ERROR. 05003000 * 05004000 * 2. TRY TO REWRITE THE LINE OR SEND A NEGATIVE 05005000 * RESPONSE. 05006000 * 05007000 * 3. RECORD A LINE TRANSACTION, A LINE ERROR, OR 05008000 * TIMEOUT. 05009000 * 05010000 * 4. WRITE AN ERROR MESSAGE. 05011000 * 05012000 * RESPONSES - 05013000 * 05014000 * NONE 05015000 * 05016000 * ERROR MESSAGES - 05017000 * 05018000 * NONE 05019000 * 05020000 *. 05021000 SPACE 3 05022000 CERROR DS 0H 05023000 MVC CCSW,ADACSW PRESERVE CSW AROUND SENSE AND LOG 05024000 TM ADACSW+4,UC TEST UNIT CHECK 05025000 BO CUNITCHK BR IF YES 05026000 TM ADACSW+4,UE TEST UNIT EXCEPTION 05027000 BO CUNITEXC BR IF YES 05028000 SPACE 1 05029000 CBADERR DS 0H ENTRY FOR UNUSUAL ERROR 05030000 BAL R14,TRERR LOG THE ERROR 05031000 B CHECKCCW GO DETERMINE I/O TYPE 05032000 EJECT 05033000 CUNITCHK DS 0H ENTRY FOR UNIT CHECK 05034000 TM ADASENSE,B'00000001' IS IT A TIMEOUT? 05035000 BO CHECKTO YES CONTINUE 05036000 BAL R14,TRERR RECORD THE ERROR 05037000 B CHECKCCW AND CONTINUE 05038000 SPACE 1 05039000 CHECKTO EQU * 05040000 OI BUFSTAT,BUFTONAK T/O ON RD,SET FOR A NAK @VA08636 05041000 BAL R14,TRTIMOT COUNT THE TIMEOUT 05042000 LH R14,TOCNT GET TIMEOUT COUNT @VA05950 05043000 LA R14,1(R14) UP BY ONE @VA05950 05044000 STH R14,TOCNT SAVE FOR LATER @VA05950 05045000 CH R14,=H'17' THRESHOLD REACHED (ABOUT 1 MIN) @VA05950 05046000 BNL EOJ @VA05950 05047000 SPACE 1 05048000 CHECKCCW EQU * 05049000 LA R14,CREWRITE PREPARE TO REWRITE 05050000 ICM R15,B'1111',CCSW GET COMMAND ADDR AND CHECK FOR ZERO 05051000 BCR 8,R14 BR IF YES TO TRY REWRITE 05052000 TM CCSW+5,CCC TEST CHANNEL CONTROL CHECK 05053000 BCR 1,R14 YES... GUESS AT REWRITE 05054000 S R15,=F'8' OTHERWISE BACK UP TO FAILED CC 05055000 CLI 0(R15),WRITE WAS IT A WRITE 05056000 BCR 8,R14 BR IF YES TO RETRY IT 05057000 CLC BUFDATA(1),COLDRCB COMPARE AGAINST LAST RCB SENT 05058000 BE CSENDNAK @VA05950 05059000 NI BUFSTAT,255-BUFTEXT OTHERWISE FORGET TEXT 05060000 B CSENDNAK @VA05950 05061000 TOCNT DC H'0' CONSECUTIVE TIMEOUT COUNTER @VA05950 05062000 SPACE 1 05063000 EJECT 05064000 * 05065000 * UNIT EXCEPTION SET 05066000 * 05067000 SPACE 3 05068000 CUNITEXC DS 0H 05069000 L R15,ADACSW GET CSW ADDR 05070000 S R15,=F'8' BACK UP TO CMD IN ERROR 05071000 MVC CUNITCMD(1),0(R15) SAVE COMMAND CODE 05072000 SPACE 1 05073000 CLI CUNITCMD,WRITE WAS THIS A WRITE... 05074000 BNE CSENDNAK BR IF NO TO FORCE RESEND (EOT REC) 05075000 SPACE 1 05076000 CDMYREAD EQU * 05077000 OI BUFSYNSW,CUWFAKE SET SWITCH TO IGNORE ERROR 05078000 BAL R15,$SIO ISSUE THE I/O 05079000 DC AL4(CCWD) WITH THIS CCW 05080000 B CREXIT AND EXIT TO AWAIT INT 05081000 EJECT 05082000 *---------------------------------------------------------------------* 05083000 * * 05084000 * IOERROR MESSAGE PRINT ROUTINE * 05085000 * * 05086000 * AT ENTRY: R1 --> TO FAILING CCW * 05087000 * * 05088000 * * 05089000 *---------------------------------------------------------------------* 05090000 SPACE 05091000 DS 0H 05092000 IOERRPRT EQU * 05093000 STM R14,R1,IOERRSV STORE REGS IN SAVE AREA 05094000 MVC IOERRLNE(8),SMLLINE STORE LINE ADDRESS IN MSG 05095000 UNPK IERRCSW1(9),ADACSW(5) SPREAD THE CSW 05096000 UNPK IERRCSW2(9),ADACSW+4(5) SPREAD THE CSW 05097000 TR IERRCSW1(16),AXSTRTAB-240 AND TRANSLATE TO HEX 05098000 MVC IERRSIO(1),ADASIOCC MOVE IN STARTIO CONDITION CODE 05099000 OI IERRSIO,X'F0' AND MAKE PRINTABLE 05100000 UNPK IERRSENS(3),ADASENSE(2) SPREAD THE DIGITS 05101000 MVI IERRSENS+2,C' ' RESTORE THE CLOBBERED BLANK 05102000 TR IERRSENS(2),AXSTRTAB-240 AND TRANSLATE TO HEX 05103000 TM ADASIOCC,X'02' BAD CONDITION? 05104000 BO IOERRPR1 YES SKIP CCW 05105000 UNPK IERRCCW1(9),0(5,R1) UNPACK THE CCW INTO MSG 05106000 UNPK IERRCCW2(9),4(5,R1) UNPACK THE CCW INTO MSG 05107000 TR IERRCCW1(16),AXSTRTAB-240 AND TRANSLATE TO HEX 05108000 IOERRPR1 EQU * 05109000 LA R0,IOERMSGL GET THE MSG LENGTH 05110000 LA R1,IOERRMSG GET THE MSG ADDR 05111000 BAL R14,MSG AND WRITE IT 05112000 MVI IERRCCW1,C'0' CLEAR FIRST BYTE 05113000 MVC IERRCCW1+1(15),IERRCCW1 AND THE REST 05114000 LM R14,R1,IOERRSV RESTORE REGISTERS 05115000 BR R14 AND RETURN 05116000 SPACE 05117000 IOERRSV DS 4F SAVE AREA 05118000 IOERRMSG DC AL2(70),AL2(0) MSG NUMBER AND SPARE 05119000 IOERRLNE DC CL8' ' LINE ADDR 05120000 IERRSIO DC CL8' ' ADAPTER SIO COND CODE 05121000 IERRCSW1 DC CL8' ' ADAPTER CSW 05122000 IERRCSW2 DC CL8' ' PART 2 OF CSW 05123000 IERRSENS DC CL8' ' ADAPTER SENSE BYTE 05124000 IERRCCW1 DC CL8'00000000' ADAPTER FAILING CCW 05125000 IERRCCW2 DC CL8'00000000' PART 2 OF CCW 05126000 IOERMSGL EQU *-IOERRMSG LENGTH OF ERROR MSG 05127000 DC CL1' ' GARBAGE BYTE 05128000 EJECT 05129000 *---------------------------------------------------------------------* 05130000 * * 05131000 * * 05132000 * EVENT TRACING ROUTINE * 05133000 * * 05134000 * ENTRY: * 05135000 * * 05136000 * TRTRAN -- TO RECORD A LINE TRANSACTION * 05137000 * TRERR -- TO RECORD A LINE ERROR * 05138000 * TRTIMOT -- TO RECORD A TIMEOUT * 05139000 * * 05140000 * * 05141000 *---------------------------------------------------------------------* 05142000 SPACE 1 05143000 DROP R6 @VA03278 05144000 USING LINKTABL,R1 GET LINK TABLE ADDRESSABILITY 05145000 SPACE 1 05146000 DS 0H 05147000 TRTRAN EQU * 05148000 STM R14,R1,TRSAVE SAVE REGISTERS 05149000 L R1,SMLLINK GET LINK TABLE ADDR 05150000 TM LFLAG,LTRALL SHOULD WE BE DOING THIS? 05151000 BNO TREXIT NO -- TIME TO EXIT 05152000 LH R15,LTRNSCNT GET THE CURRENT COUNT 05153000 LA R15,1(,R15) UP BY ONE 05154000 STH R15,LTRNSCNT AND REPLACE IN COUNT FIELD 05155000 CL R15,TRASHLD IS IT TIME TO PRINT? 05156000 BL TREXIT NO RETURN 05157000 B TRPRT GO PRINT THE MSG 05158000 SPACE 05159000 TRERR EQU * 05160000 STM R14,R1,TRSAVE SAVE REGISTERS 05161000 L R1,SMLLINK GET LINK TABLE ADDR 05162000 TM LFLAG,LTRALL+LTRERR SHOULD WE BE DOING THIS? 05163000 BZ TREXIT NO -- TIME TO EXIT 05164000 LH R15,LERRCNT GET THE CURRENT COUNT 05165000 LA R15,1(,R15) UP BY ONE 05166000 STH R15,LERRCNT AND REPLACE IN COUNT FIELD 05167000 CL R15,ERRSHLD IS IT TIME TO PRINT? 05168000 BL TREXIT NO RETURN 05169000 B TRPRT GO PRINT THE MSG 05170000 SPACE 05171000 TRTIMOT EQU * 05172000 STM R14,R1,TRSAVE SAVE REGISTERS 05173000 L R1,SMLLINK GET LINK TABLE ADDR 05174000 TM LFLAG,LTRALL+LTRERR SHOULD WE BE DOING THIS? 05175000 BZ TREXIT NO -- TIME TO EXIT 05176000 LH R15,LTOCNT GET THE CURRENT COUNT 05177000 LA R15,1(,R15) UP BY ONE 05178000 STH R15,LTOCNT AND REPLACE IN COUNT FIELD 05179000 CL R15,ERRSHLD IS IT TIME TO PRINT? 05180000 BL TREXIT NO RETURN 05181000 EJECT 05182000 TRPRT EQU * 05183000 MVC TRLINK(8),AXSLINK MOVE LINKID INTO MSG 05184000 LH R15,LTRNSCNT GET THE CURRENT COUNT 05185000 CVD R15,TRCVD CONVERT TO DECIMAL 05186000 UNPK TRMTRN,TRCVD SPREAD THE DIGITS 05187000 OI TRMTRN+7,X'F0' MAKE THE LAST ONE PRINTABLE 05188000 LH R15,LERRCNT GET THE CURRENT COUNT 05189000 CVD R15,TRCVD CONVERT TO DECIMAL 05190000 UNPK TRMERR,TRCVD SPREAD THE DIGITS 05191000 OI TRMERR+7,X'F0' MAKE THE LAST ONE PRINTABLE 05192000 LH R15,LTOCNT GET THE CURRENT COUNT 05193000 CVD R15,TRCVD CONVERT TO DECIMAL 05194000 UNPK TRMTO,TRCVD SPREAD THE DIGITS 05195000 OI TRMTO+7,X'F0' MAKE THE LAST ONE PRINTABLE 05196000 SR R15,R15 CLEAR OUT R15 05197000 STH R15,LTRNSCNT CLEAR THE COUNTER 05198000 STH R15,LERRCNT CLEAR THE COUNTER 05199000 STH R15,LTOCNT CLEAR THE COUNTER 05200000 LA R0,TRMSGL GET THE MSG LENGTH 05201000 LA R1,TRMSG GET THE MSG ADDR 05202000 BAL R14,MSG AND WRITE OUT THE MSG 05203000 SPACE 05204000 TREXIT EQU * 05205000 LM R14,R1,TRSAVE RESTORE THE REGS 05206000 BR R14 AND RETURN 05207000 SPACE 05208000 TRCVD DS D CVD AREA 05209000 TRSAVE DS 4F SAVE AREA 05210000 SPACE 05211000 TRMSG DC AL2(149),AL2(0) NUMBER PLUS SPARE 05212000 TRLINK DC CL8' ' LINKID 05213000 TRMTRN DC CL8' ' TRANSACTION COUNT 05214000 TRMERR DC CL8' ' ERROR COUNT 05215000 TRMTO DC CL8' ' TIMEOUT COUNT 05216000 TRMSGL EQU *-TRMSG LENGTH OF MSG 05217000 SPACE 05218000 TRASHLD DC F'60' THRESHOLD LEVEL FOR MSG 05219000 ERRSHLD DC F'20' THRESHOLD LEVEL FOR MSG 05220000 EJECT 05221000 *---------------------------------------------------------------------* 05222000 * * 05223000 * ADAPTER SIO ROUTINE * 05224000 * * 05225000 *---------------------------------------------------------------------* 05226000 SPACE 1 05227000 $SIO DS 0H 05228000 MVC ADCCWA+1(3),1(R15) MOVE CCW ADDRESS TO IOB 05229000 MVC CLASTCAW,0(R15) SAVE 05230000 STM R11,R2,ADSAV SAVE REGS 05231000 MVI ADASENSE,X'00' CLEAR SENSE BYTE 05232000 L R14,CLASTCAW RETRIEVE LAST CAW 05233000 CLI 0(R14),DISABLE IS IT A DISABLE? @VA04353 05234000 BE RSIO YES...DON'T LOG IT @VA04353 05235000 CLI 0(R14),READ IS IT A READ? @VA04353 05236000 BE NOTWRITE YES...DON'T BUMP POINTER @VA04353 05237000 LA R14,8(R14) POINT TO WRITE DATA CCW @VA04353 05238000 NOTWRITE MVC KCCW,0(R14) SAVE CCW @VA04353 05239000 L R14,0(R14) GET CCW ADDR 05240000 LA R1,W INDICATE WRITE TO LOG 05241000 BAL R15,KLOGIT GO LOG THE WRITE 05242000 RSIO EQU * 05243000 XC ADAECB(4),ADAECB CLEAR OUT ADAPTER SYNCH LOCK 05244000 LA R1,ADAECB GET ADAPTER IO BLOCK ADDR 05245000 L R15,IOREQ SYSTEM I/O REQUEST PROCESSOR 05246000 BALR R14,R15 GO EXECUTE THE I/O 05247000 CLI ADASIOCC,X'00' DID IT START OKAY 05248000 BE RSIO1 OKAY CONTINUE 05249000 L R1,CLASTCAW GET LAST CCW ADDR 05250000 BAL R14,IOERRPRT WRITE THE ERROR MSG 05251000 CLI ADASIOCC,NOP LINE NOT THERE? @VA08191 05252000 BE SMLCRASH YES, EXIT W/O DISABLE @VA08191 05253000 B RSIO AND RETRY 05254000 SPACE 1 05255000 RSIO1 EQU * 05256000 LM R11,R2,ADSAV RESTORE REGS 05257000 B 4(R15) BACK TO USER 05258000 EJECT 05259000 *---------------------------------------------------------------------* 05260000 * * 05261000 * LOG ROUTINE * 05262000 * * 05263000 *---------------------------------------------------------------------* 05264000 SPACE 3 05265000 USING IOTABLE,R1 GET IOTABLE ADDRSSABILITY 05266000 KTAB DC C'0123456789ABCDEF' TRANSLATE TAB 05267000 KSAV DC 6F'0' SAVE AREA 05268000 KLOGIT STM R13,R2,KSAV SAVE REGISTERS 05269000 TM $LOGSW,LOGON IS LOGING SET ON? 05270000 BNOR R15 (BN0 RSIO) NO...RETURN @VA04353 05271000 TM $LOGSW,LOGOPEN IS THE LOG DEVICE OPEN? 05272000 BO LOGCONT YES CONTINUE 05273000 LA R1,LOGBLK GET LOG REQUEST BLOCK 05274000 LA R0,X'11' INDICATE OPEN 05275000 BAL R14,AXS GO GET A DEVICE 05276000 MVC LOGLINK(8),AXSLINK SET LINKID IN MSG 05277000 LA R1,LOGTIME GET BUFFER FOR DIAG 05278000 DIAG R1,R2,X'0C' GET TIME AND DATA FROM VM 05279000 MVC LOGDTIME(8),LOGTIME MOVE TO MSG 05280000 MVC LOGDTIME+9(8),LOGTIME+8 MOVE TO MSG 05281000 L R1,LOGFIOA GET FIOA ADDR 05282000 MVC PROGADDR(4),=A(LOGHDCCW) MOVE CCW ADDR TO CAW 05283000 B WRLOG1 AND CONTINUE 05284000 SPACE 1 05285000 LOGCONT EQU * 05286000 UNPK IOLINE(15),0(8,R14) CONVERT THE FIRST PART OF BUFFER 05287000 TR IOLINE(14),KTAB-240 TO EBCDIC 05288000 UNPK IOLINE+14(15),7(8,R14) CONVERT THE SECOND PART OF BUFFER 05289000 TR IOLINE+14(14),KTAB-240 TO EBCDIC 05290000 UNPK IOLINE+28(15),14(8,R14) AND THE LAST PART 05291000 TR IOLINE+28(14),KTAB-240 TO EBCDIC 05292000 MVI IOLINE+42,C' ' RESTORE CLOBBERED BLANK 05293000 UNPK IOLINE+43(15),ADACSW+1(8) CONVERT THE CSW 05294000 TR IOLINE+43(14),KTAB-240 TO EBCDIC 05295000 MVI IOLINE+57,C' ' RESTORE CLOBBERED BLANK 05296000 UNPK IOLINE+58(7),ADAECB(4) CONVERT THE SYNCH LOCK 05297000 TR IOLINE+58(6),KTAB-240 TO EBCDIC 05298000 MVI IOLINE+64,C' ' RESTORE CLOBBERED BLANK 05299000 UNPK IOLINE+66(3),ADASENSE(2) CONVERT THE SENSE INFO @VA04353 05300000 TR IOLINE+66(2),KTAB-240 ...TO EBCDIC @VA04353 05301000 MVI IOLINE+68,C' ' RESTORE CLOBBERED BLANK @VA04353 05302000 CLI 0(R1),C'W' CHECK FOR WRITE 05303000 BE WRLOG2 CSW NOT USEFUL @VA04353 05304000 ICM R1,B'0111',ADACSW+1 LAST CCW ADDRESS @VA04353 05305000 BZ KFULL INVALID ADDRESS @VA04353 05306000 S R1,=F'8' BACK UP TO LAST CCW @VA04353 05307000 MVC KCCW,0(R1) SAVE CCW @VA04353 05308000 WRLOG2 UNPK IOLINE+70(9),KCCW(5) CCW1 @VA04353 05309000 TR IOLINE+70(8),KTAB-240 TRANSLATE @VA04353 05310000 UNPK IOLINE+78(9),KCCW+4(5) CCW2 @VA04353 05311000 TR IOLINE+78(8),KTAB-240 MAKE IT EBCDIC @VA04353 05312000 MVI IOLINE+86,C' ' RESTORE CLOBBERED BLANK @VA04353 05313000 CLI IOLINE+70,WRITE IS IT A WRITE? @VA04353 05314000 BNE WRLOG NO..MUST BE READ 05315000 L R13,KSAV RESTORE R13 05316000 UNPK IOLINE+43(15),0(8,R13) LETS SEE THE FIRST PART OF THE BU 05317000 TR IOLINE+43(14),KTAB-240 TO EBCDIC 05318000 MVI IOLINE+57,C' ' RESTORE CLOBBERED BLANK 05319000 EJECT 05320000 WRLOG EQU * 05321000 TM KCCW+4,SKIP TRANSFER SUPPRESSED? @VA04353 05322000 BO KWRITE NO BUFFER TO DISPLAY @VA04353 05323000 LH R14,KCCW+6 LOAD CCW BYTE COUNT @VA04353 05324000 CLI KCCW,WRITE IS IT A WRITE? @VA04353 05325000 BE KWRITE NOT LAST CCW @VA04353 05326000 SH R14,ADACSW+6 RESIDUAL BYTE COUNT @VA04353 05327000 KWRITE SLA R14,1 *2 FOR UNPACK @VA04353 05328000 CL R14,=F'40' MORE THAN 40 BYTES? @VA04353 05329000 BH KFULL YES...IOLINE IS FULL @VA04353 05330000 LA R1,IOLINE(R14) ADDRESS OF BLANKING AREA @VA04353 05331000 LA R14,IOLINE+41 END OF BLANKING AREA-1 @VA04353 05332000 SR R14,R1 SIZE OF BLANKING AREA-1 @VA04353 05333000 MVI 0(R1),C' ' BLANK OUT THE AREA @VA04353 05334000 EX R14,MVCBLANK @VA04353 05335000 KFULL EQU * @VA04353 05336000 L R1,LOGFIOA GET LOG DEVICE BLOCK ADDR 05337000 MVC PROGADDR(4),=A(LOGCCW) SET LOG CAW 05338000 WRLOG1 EQU * 05339000 XC IOSYNCH(4),IOSYNCH CLEAR SYNCH LOCK 05340000 L R15,IOREQ SYSTEM IO ROUTINE ADDR 05341000 BALR R14,R15 EXECUTE THE IO 05342000 L R15,WAITREQ PREPARE FOR WAIT 05343000 BALR R14,R15 AND WAIT FOR COMPLETION 05344000 MVI IOLINE,C' ' MAKE THE.... @VA04353 05345000 MVC IOLINE+1(119),IOLINE ....IOLINE BLANK @VA04353 05346000 LOGRET EQU * 05347000 LM R13,R2,KSAV RESTORE REGISTERS 05348000 TM $LOGSW,LOGOPEN IS THE LOG OPEN? @VA04353 05349000 BOR R15 YES...ALL DONE,RETURN. @VA04353 05350000 OI $LOGSW,LOGOPEN SET LOG OPEN @VA04353 05351000 B LOGCONT MAKE THE FIRST ENTRY @VA04353 05352000 DROP R1 @VA04353 05353000 DS 0H @VA04353 05354000 KCCW DC XL8'0' SAVED CCW @VA04353 05355000 MVCBLANK MVC 1(0,R1),0(R1) EXECUTED MVC @VA04353 05356000 IOLINE DC CL120' ' LOG PRINT LINE 05357000 R DC C'R' READ 05358000 W DC C'W' WRITE 05359000 SPACE 1 05360000 $LOGSW DC X'00' LOG SWITCH 05361000 * BITS DEFINED IN $LOGSW 05362000 LOGON EQU X'80' LOGING SET ON 05363000 LOGOPEN EQU X'40' LOG DEVICE OPEN 05364000 SPACE 1 05365000 DS 0F 05366000 LOGBLK DC F'0' SYNCH LOCK 05367000 DC CL4'AXS ' FILE ACCESS TASK NAME 05368000 DC A(LOGGREQ) REQUEST BUFFER ADDRESS 05369000 DC AL1(19),AL3(LOGGREQ) RESPONSE BUFFER ADDRESS 05370000 LOGGREQ DC AL1(19,0,0,0) LENGTH,FUNCTION,SPARE,SUBCODE 05371000 DC A(LOGTAG) LOG TAG ADDRESS 05372000 LOGFIOA DC A(0) FILE I/O AREA ADDRESS 05373000 DC CL8' ' LINK ID 05374000 SPACE 1 05375000 LOGTAG DC 108CL1' ' LOG TAG 05376000 SPACE 1 05377000 DS 0D 05378000 LOGCCW CCW X'09',IOLINE,SILI,120 WRITE AND SPACE 1 05379000 LOGHDCCW CCW X'19',LOGHDLNE,SILI,LOGHDRLN WRITE AND SPACE 3 05380000 SPACE 1 05381000 LOGHDLNE DC CL3' ' 05382000 DC C'D M T S M L LINE TRANSACTION LOG FOR LINK ' 05383000 LOGLINK DC CL8' ' 05384000 DC C' ON ' 05385000 LOGDTIME DC CL17' ' 05386000 LOGHDRLN EQU *-LOGHDLNE LENGTH OF HDR LINE 05387000 DS 0D 05388000 LOGTIME DC CL32' ' DIAG BUFFER 05389000 EJECT 05390000 *---------------------------------------------------------------------* 05391000 * * 05392000 * CLOSE LOG ROUTINE * 05393000 * * 05394000 *---------------------------------------------------------------------* 05395000 SPACE 1 05396000 DC 0H'0' 05397000 LOGCLOSE EQU * 05398000 TM $LOGSW,LOGOPEN IS LOG RUNNING @VA08193 05399000 BZR R14 QUICK RETURN IF NO @VA08193 05400000 STM R14,R1,LOGCLSAV SAVE REGISTERS 05401000 NI $LOGSW,255-LOGON-LOGOPEN RESET FLAGS 05402000 LA R1,LOGBLK GET LOG REQUEST BLOCK 05403000 LA R0,X'12' INDICATE CLOSE 05404000 BAL R14,AXS GET RID OF LOG DEVICE 05405000 LM R14,R1,LOGCLSAV RESTORE REGISTERS 05406000 BR R14 AND RETURN @VA08193 05407000 SPACE 1 05408000 LOGCLSAV DS 4F SAVE AREA 05409000 EJECT 05410000 SPACE 7 05411000 DS 0H 05412000 EOJ EQU * @VA05662 05413000 BAL R15,$SIO DISABLE LINE @VA08191 05414000 DC AL4(CCWOFF) USE THIS CHAN PROGRM @VA08191 05415000 LA R1,ADAECB BSC ADAPTER SYNC LOCK @VA08191 05416000 L R15,WAITREQ GO TO WAIT @VA08191 05417000 BALR R14,R15 FOR DISABLE COMPLETE @VA08191 05418000 SMLCRASH EQU * NO DISABLE ISSUED HERE @VA08191 05419000 TM MASTERSW,PRINTER PRINTER DEVICE OPEN ? @VA05662 05420000 BZ NOPRTF NO, NO PRINT FILE TO CLOSE @VA05662 05421000 LA R1,PDEVSYNC PRINTER DEVICE BLOCK @VA05662 05422000 LA R0,X'12' CLOSE FUNCTION BYTE @VA05662 05423000 BAL R14,AXS CALL AXS TO CLOSE @VA05662 05424000 NOPRTF TM MASTERSW,PUNCH PUNCH DEVICE OPEN ? @VA05662 05425000 BZ NOPUNF NO, NO PUNCH FILE TO CLOSE @VA05662 05426000 LA R1,UDEVSYNC PUNCH DEVICE BLOCK @VA05662 05427000 LA R0,X'12' CLOSE FUNCTION BYTE @VA05662 05428000 BAL R14,AXS CALL AXS TO CLOSE @VA05662 05429000 NOPUNF TM MASTERSW,JOB JOB PUNCH OPEN ? @VA05662 05430000 BZ NOJOBF NO, NO JOB PUNCH FILE TO CLOSE @VA05662 05431000 L R15,JDEVFIOA JOB PUNCH FILE BLOCK @VA05662 05432000 UNPK TAGCMD+7(5),DEVCUU-IOTABLE(3,R15) UNPACK DEV @VA05662 05433000 * ADDR 05434000 MVI TAGCMD+7,C' ' CLEAR CLOBBERED BYTE @VA05662 05435000 MVI TAGCMD+11,C' ' @VA05662 05436000 TR TAGCMD+8(3),AXSTRTAB-240 TRANSLATE TO EBCDIC @VA05662 05437000 LA R1,TAGCMD ADDRESS OF TAG COMMAND @VA05662 05438000 LA R2,TAGCMDL LENGHT @VA05662 05439000 DIAG R1,R2,8 ISSUE TAG COMMAND @VA05662 05440000 LA R1,JDEVSYNC PUNCH DEVICE BLOCK @VA05662 05441000 LA R0,X'12' CLOSE FUNCTION BYTE @VA05662 05442000 BAL R14,AXS CALL AXS TO CLOSE @VA05662 05443000 NOJOBF TM MASTERSW,READER READER OPEN ? @VA05662 05444000 BZ NORDRF NO, NO READER FILE TO CLOSE @VA05662 05445000 LA R1,RDEVSYNC READER DEVICE BLOCK @VA05662 05446000 LA R0,X'02' CLOSE FUNCTION CODE @VA05662 05447000 MVI 19(R1),X'81' CLOSE KEEP, NOHOLD OPTION @VA05662 05448000 BAL R14,AXS CALL AXS TO CLOSE @VA05662 05449000 NORDRF EQU * @VA05662 05450000 BAL R14,LOGCLOSE ENSURE LOG CLOSE @VA08193 05451000 MSG 143,(AXSLINK,SMLLINE) WRITE THE MSG 05452000 LA R1,TERMBLK GET TERMINATE GIVE BUFFER 05453000 L R15,GIVEREQ GET GIVE PROCESSOR ADDRESS 05454000 BALR R14,R15 GO EXECUTE THE REQUEST 05455000 L R15,WAITREQ GET SYSTEM WAIT ROUTINE 05456000 LA R1,LONGWAIT A VERY LONG WAIT 05457000 BALR R14,R15 WAIT A LONG TIME 05458000 SIGNOFF DC C'/*SIGNOFF' SIGNOFF CARD @VA08191 05459000 SPACE 2 05460000 DS 0F 05461000 TERMBLK DC F'0',CL4'REX ',A(TERMREQ),A(0) GIVE REQUEST BLOCK 05462000 SPACE 1 05463000 TERMREQ DC AL1(1),X'03' LENGTH,FUNCTION 05464000 LONGWAIT DC F'0' LONG WAIT SYNCH LOCK 05465000 EJECT 05466000 CBUFFER DC A(0) ACTIVE COMUNICATIONS BUFFER 05467000 CFCSOUT DC X'8FCF' LAST FCS TRANSMITTED @VA04174 05468000 CFCSSTD DC X'88C1' STANDARD FCS @VA03425 05469000 CFCSTEMP DC AL2(0) FCS COMPARE AREA @VA03301 05470000 CTEMP DC H'0' TEMPORARY STORAGE 05471000 CMAXDUP DC H'3' MAX REPEATED BLOCKS 05472000 DC AL1(0) FIRST BYTE OF HALF-WORD 05473000 CBCBCNTO DC AL1(X'80') BLOCK CHECK COUNT OUT 05474000 DC AL1(0) SPACER 05475000 CBCBCNTI DC AL1(X'80') BLOCK COUNT CHARACTER EXPECTED 05476000 DC H'0' * 05477000 CBUFLAST DC 10X'00' SAVE OF START OF LAST BUFFER 05478000 CRESP DC AL1(0) RESPONSE CHARACTER RECEIVED 05479000 CREGS DS 3F REGISTER SAVE AREA 05480000 SPACE 1 05481000 CRETREGS DS 3F SAVE AREA 05482000 $COMEXIT DC A($START) COMSUP INITIAL ENTRY POINT 05483000 SPACE 1 05484000 CBCB DC X'00' LAST BCB SENT 05485000 CSETBCB DC X'00' HERE TOO..FOR RESET 05486000 SPACE 1 05487000 DS 0F FORCE FULL-WORD ALIGNMENT 05488000 CCSW DC XL8'00' TEMP STORAGE FOR CSW 05489000 COLDRCB DC X'00' LAST RCB SENT 05490000 CUNITCMD DC X'00' COMMAND CODE STORAGE 05491000 SPACE 1 05492000 CLASTCAW DC F'0' CCW ADDR SAVE 05493000 SPACE 2 05494000 BUFSYNSW DC X'00' BUFFER SYNCHRONIZATION SWITCH 05495000 * BITS DEFINED IN BUFSYNSW 05496000 $TPPNONE EQU X'80' STOP ALL BUFFERING 05497000 OFLSW EQU X'40' FLUSH BUFFER 05498000 GDQBUFS EQU X'20' STOP DEQUEUING BUFFERS 05499000 $COMBUSY EQU X'10' COMMUNICATIONS INACTIVE 05500000 CUWFAKE EQU X'08' DUMMY READ ON FOR UE RECOVERY 05501000 CACKSW EQU X'04' ACK RECEIVED 05502000 EJECT 05503000 ADAECB DC F'0' SYNCH LOCK 05504000 ADACUU DC X'0000',AL1(1),AL1(TYP2700) 05505000 ADCCWA DC A(CCTCCW) ADAPTER CCW ADDR 05506000 ADASIOCC EQU * SIO CONDITION CODE 05507000 ADACSW DC 2F'0' ADAPTER ENDING CSW 05508000 ADASENSE DC F'0' ADAPTER SENSE BYTE 05509000 SPACE 3 05510000 ADSAV DC 8F'0' $SIO REGISTER SAVE AREA 05511000 RDCOUNT DC H'0' READ BUFFER SIZE @VA07451 05512000 DUMCOUNT DC H'0010' MAX BUFFER FOR RD COUNT @VA08578 05513000 EJECT 05514000 * CONTROL SEQUENCES 05515000 XSTXSEQ DC AL1(XLDR,XSTX) START-OF-TEXT SEQUENCE 05516000 XETBSEQ DC AL1(XTRL,XETB) END-OF-TEXT-BLOCK SEQUENCE 05517000 XACKSEQ DC AL1(XDLE,XACK0) POSITIVE ACKNOWLEDGEMENT SEQUENCE 05518000 XNAKSEQ DC AL1(XSYN,XNAK) NEGATIVE ACKNOWLEDGEMENT SEQUENCE 05519000 XSYNSEQ DC AL1(XSYN,XSYN,XSYN,XSYN) SYNCHRONIZATION SEQUENC@VA03340 05520000 SPACE 2 05521000 * CHANNEL COMMAND WORDS 05522000 SPACE 1 05523000 * NORMAL DATA WRITE WITH RETURN DATA READ 05524000 SPACE 1 05525000 CCWS CCW 1,XSYNSEQ,CD+SILI,4 SYNCHRONIZATION SEQUENCE @VA03340 05526000 CCWA CCW 1,0,CC+SILI,0 WRITE BUFFER 05527000 CCWB CCW 1,XETBSEQ,CC+SILI,2 WRITE ENDING SEQUENCE 05528000 CCWC CCW 2,0,SILI,0 READ RETURN DATA 05529000 SPACE 1 05530000 * DUMMY READ TO TURN OFF LOST DATA SENSE 05531000 SPACE 1 05532000 CCWD CCW 2,0,SILI+SKIP,65000 NON-READ A BUNCH 05533000 SPACE 1 05534000 * DISABLE COMMAND 05535000 CCWOFF CCW X'2F',0,SILI,1 DISABLE 05536000 SPACE 1 05537000 WRITE EQU X'01' ADAPTER WRITE COMMAND CODE 05538000 READ EQU X'02' ADAPTER READ COMMAND CODE 05539000 NOP EQU X'03' ADAPTER NOP COMMAND CODE 05540000 SENSE EQU X'04' ADAPTER SENSE COMMAND CODE 05541000 DISABLE EQU X'2F' ADAPTER DISABLE COMMAND @VA04353 05542000 EJECT 05543000 SPACE 2 05544000 * PROTOTYPE CTL RECORD TO TELL THAT BLOCKS ARE LOST 05545000 SPACE 1 05546000 CLOSTBLK DS 0H START 05547000 DC AL2(CLOSTEND-CLOSTBS) BUFCOUNT 05548000 DC AL1(BUFTEXT) BUFSTAT 05549000 CLOSTBS DC AL1(XLDR,XSTX) BUFSTART 05550000 CLOSTBCB DC AL1(X'80'+BCBIGNRE) BUFBCB(RECEIVED BLOCK CT ADDED 05551000 CLOSTFCS DC AL2(0) FCS 05552000 DC AL1(X'E0') RCB (CTL REC,TYPE=LOST DATA) 05553000 CLSTSRCB DC AL1(X'80') SRCB(EXPECTED BLK CT ADDED) 05554000 DC AL1(0) SCB (NULL RECORD) 05555000 DC AL1(0) RCB (END OF BLOCK) 05556000 CLOSTEND EQU * END OF PROTOTYPE 05557000 SPACE 1 05558000 CDUMMY DC A(0) NO CHAIN 05559000 DC AL2(CDUMEND-CDUMSTRT) COUNT 05560000 DC AL1(BUFFAKE) BUFSTAT 05561000 CDUMSTRT DC AL1(XLDR,XSTX) BUFSTART 05562000 DC AL1(X'80'+BCBIGNRE) BUFBCB 05563000 DC AL2(0) FCS 05564000 DC AL1(0) RCB (EOB) 05565000 CDUMEND EQU * END OF DUMMY BUFFER 05566000 SPACE 1 05567000 CUEFAKE DC A(0) BUFCHAIN 05568000 DC AL2(0) BUFCOUNT 05569000 DC AL1(BUFFAKE+BUFUCHEK) BUFFER STATUS 05570000 DC CL10' ' DUMMY AREA JUST IN CASE 05571000 SPACE 1 05572000 ICTLS DS 0H CONTROL INFO FOR BUFFER 05573000 DC AL2(ICTLE-*-3) BUFCOUNT 05574000 DC X'00' BUFSTAT 05575000 DC AL1(XLDR,XSTX) BUFSTART 05576000 DC AL1(X'80'+BCBRESET) BUFBCB (RESETS EXPECTED BLOCK CT) 05577000 DC AL2(0) FCS 05578000 DC X'F0' GENERAL CONTROL TYPE RCB 05579000 DC C'A' SIGN-ON ID 05580000 ICTXT DS 0CL80 05581000 DC CL15'/*SIGNON' 05582000 ICTXTSY DC CL6'RM000' 05583000 ICTNUM DC CL59' ' 05584000 DC AL1(0) EOR 05585000 ICTLE EQU * 05586000 SPACE 05587000 RESCARD DC C'LOGON ' LOGON CARD 05588000 RESID DC CL19' ' LOGON ID/PASSWORD @VM01162 05589000 DC C'TERM(' @VM01162 05590000 RESTERM DC C' ' TERMINAL ID @VM01162 05591000 EJECT 05592000 LTORG 05593000 EJECT 05594000 * 05595000 * FUNCTION CONTROL MASKS FOR TCTS 05596000 * 05597000 CFCS EQU X'0000' CONTROL RECORD PROCESSOR 05598000 SPACE 1 05599000 PFCS1 EQU X'0800' PRINTER 1 05600000 PFCS2 EQU X'0400' PRINTER 2 05601000 PFCS3 EQU X'0200' PRINTER 3 05602000 PFCS4 EQU X'0100' PRINTER 4 05603000 PFCS5 EQU X'0008' PRINTER 5 05604000 PFCS6 EQU X'0004' PRINTER 6 05605000 PFCS7 EQU X'0002' PRINTER 7 05606000 SPACE 1 05607000 UFCS1 EQU X'0001' PUNCH 1 05608000 UFCS2 EQU X'0002' PUNCH 2 05609000 UFCS3 EQU X'0004' PUNCH 3 05610000 UFCS4 EQU X'0008' PUNCH 4 05611000 UFCS5 EQU X'0100' PUNCH 5 05612000 UFCS6 EQU X'0200' PUNCH 6 05613000 UFCS7 EQU X'0400' PUNCH 7 05614000 SPACE 1 05615000 WFCS1 EQU X'0040' CONSOLE 05616000 OFCS1 EQU X'0000' OPERATOR COMMAND FCS 05617000 SPACE 1 05618000 RFCS1 EQU X'0800' READER FUNCTION 1 05619000 RFCS2 EQU X'0400' READER FUNCTION 2 05620000 RFCS3 EQU X'0200' READER FUNCTION 3 05621000 RFCS4 EQU X'0100' READER FUNCTION 4 05622000 RFCS5 EQU X'0008' READER FUNCTION 5 05623000 RFCS6 EQU X'0004' READER FUNCTION 6 05624000 RFCS7 EQU X'0002' READER FUNCTION 7 05625000 SPACE 1 05626000 WAITABIT EQU X'4000' WAIT-A-BIT 05627000 EJECT 05628000 * 05629000 * RECORD CONTROL BYTES 05630000 * 05631000 CRCB EQU X'80' CONTROL RECORD CONTROL BYTE 05632000 SPACE 1 05633000 PRCB1 EQU X'94' STREAM 1 PRINT RECORDS 05634000 PRCB2 EQU X'A4' STREAM 2 PRINT RECORDS 05635000 PRCB3 EQU X'B4' STREAM 3 PRINT RECORDS 05636000 PRCB4 EQU X'C4' STREAM 4 PRINT RECORDS 05637000 PRCB5 EQU X'D4' STREAM 5 PRINT RECORDS 05638000 PRCB6 EQU X'E4' STREAM 6 PRINT RECORDS 05639000 PRCB7 EQU X'F4' STREAM 7 PRINT RECORDS 05640000 SPACE 1 05641000 URCB1 EQU X'95' STREAM 1 PUNCH RECORDS 05642000 URCB2 EQU X'A5' STREAM 2 PUNCH RECORDS 05643000 URCB3 EQU X'B5' STREAM 3 PUNCH RECORDS 05644000 URCB4 EQU X'C5' STREAM 4 PUNCH RECORDS 05645000 URCB5 EQU X'D5' STREAM 5 PUNCH RECORDS 05646000 URCB6 EQU X'E5' STREAM 6 PUNCH RECORDS 05647000 URCB7 EQU X'F5' STREAM 7 PUNCH RECORDS 05648000 SPACE 1 05649000 WRCB1 EQU X'91' MESSAGE TO TERM OPERATOR 05650000 ORCB1 EQU X'92' OPERATOR COMMAND RCB 05651000 SPACE 1 05652000 RRCB1 EQU X'93' STREAM 1 05653000 RRCB2 EQU X'A3' STREAM 2 05654000 RRCB3 EQU X'B3' STREAM 3 05655000 RRCB4 EQU X'C3' STREAM 4 05656000 RRCB5 EQU X'D3' STREAM 5 05657000 RRCB6 EQU X'E3' STREAM 6 05658000 RRCB7 EQU X'F3' STREAM 7 05659000 EJECT 05660000 SPACE 3 05661000 * CONTROL CHARACTERS 05662000 SPACE 2 05663000 XSOH EQU X'01' START OF HEADING 05664000 XSTX EQU X'02' START OF TEXT 05665000 XETX EQU X'03' END OF TEXT 05666000 XDLE EQU X'10' DATA LINK ESCAPE 05667000 XETB EQU X'26' END OF TEXT BLOCK 05668000 XENQ EQU X'2D' ENQUIRY 05669000 XSYN EQU X'32' SYNCHRONIZATION 05670000 XEOT EQU X'37' LOST BLOCK ALARM 05671000 XNAK EQU X'3D' NEGATIVE ACKNOWLEDGEMENT 05672000 XACK1 EQU X'61' POSITIVE ACKNOWLEDGEMENT-CONDITIONAL 05673000 XACK0 EQU X'70' POSITIVE ACKNOWLEDGEMENT 05674000 XLDR EQU XDLE TRANSPARENT HEADER 05675000 XTRL EQU XDLE TRANSPARENT TRAILER 05676000 XCHN EQU X'60' TRANSPARENT CCW CHAINING BITS 05677000 SPACE 2 05678000 * BLOCK CONTROL BYTE INDICATORS 05679000 SPACE 2 05680000 BCBIGNRE EQU X'10' IGNORE BLOCK COUNT INDICATOR 05681000 BCBRESET EQU X'20' RESET BLOCK COUNT INDICATOR 05682000 EJECT 05683000 TCTDSECT DSECT 05684000 SPACE 1 05685000 *** TCT - TASK CONTROL TABLE 05686000 * 05687000 * 0 +-----------------------+-----------------------+ 05688000 * | TCTSTRT | TCTENTY | 05689000 * 4 +-----------------------+-----------------------+ 05690000 * | TCTRTN | 05691000 * 8 +-----------+-----------------------------------+ 05692000 * | TCTCCW | TCTDATA | 05693000 * C +-----------+-----------+-----------------------+ 05694000 * | TCTFLAG | TCTOPCOD | TCTCCWCT | 05695000 * 10 +-----------+-----------+-----------+-----------+ 05696000 * | TCTECB | TCTSTAT | TCTWFB | | 05697000 * 14 +-----------+-----------+-----------+-----------+ 05698000 * | TCTFCS | TCTRCBR | TCTRCBT | 05699000 * 18 +-----------------------+-----------+-----------+ 05700000 * | TCTCOM | 05701000 * 1C +-----------------------------------------------+ 05702000 * | TDEVSYNC | 05703000 * 20 +-----------------------------------------------+ 05704000 * | TDEVREQN | 05705000 * 24 +-----------------------------------------------+ 05706000 * | TDEVREQ | 05707000 * 28 +-----------------------------------------------+ 05708000 * | TDEVRESP | 05709000 * 2C +-----------+-----------+-----------+-----------+ 05710000 * | TDEVRLEN | TDEVFUN | TDEVRESV | TDEVSOPT | 05711000 * 30 +-----------+-----------+-----------+-----------+ 05712000 * | TDEVTAG | 05713000 * 34 +-----------------------------------------------+ 05714000 * | TDEVFIOA | 05715000 * 38 +-----------------------------------------------+ 05716000 * | TDEVLINK | 05717000 * 3C +-----------+-----------+-----------+-----------+ 05718000 * | TSW1 | TSW2 | TSW3 | TSW4 | 05719000 * 40 +-----------+-----------+-----------+-----------+ 05720000 * | | 05721000 * | TCTTOVM | 05722000 * | | 05723000 * 48 +-----------------------------------------------+ 05724000 * | TCTTANK | 05725000 * 4C +-----------------------------------------------+ 05726000 * | TCTBUFER | 05727000 * 50 +-----------+-----------+-----------+-----------+ 05728000 * | TCTTNKLM | TCTTNKCT | TCTBUFLM | TCTBUFCT | 05729000 * 54 +-----------+-----------+-----------+-----------+ 05730000 * 05731000 *** TCT - TASK CONTROL TABLE 05732000 SPACE 1 05733000 TTCT DS 0H 05734000 TCTSTRT DS CL2 B TO PROPER PROCESSOR ENTRY 05735000 TCTENTY DS CL2 ADR PORTION ***MODIFIED BY PROCE 05736000 TCTRTN DS CL4 B TO NEXT PROCESSOR VIA COMMUTAT 05737000 TCTCCW DS CL1 CCW FOR DEVICE OP-CODE 05738000 TCTDATA DS AL3 ADDRESS OF DATA TRANSFERRED 05739000 TCTFLAG DS CL1 FLAGS ON CCW 05740000 TCTOPCOD DS CL1 SAVE AREA FOR CCW OP-CODE 05741000 TCTCCWCT DS AL2 CCW COUNT OF DATA TRANSFERRED 05742000 TCTECB DS CL1 EVENT CONTROL 05743000 TCTSTAT DS CL1 STATUS FLAGS 05744000 TCTWFB DS AL1 WAITING FOR BUFFERS 05745000 TCTSAV1 DS 1F SAVE AREA FOR PROCESSOR ROUTINE 05746000 TCTNEXT DS 1F NEXT TCT IN CHAIN 05747000 TCTFCS DS AL2 FUNCTION CONTROL SEQUENCE MASK 05748000 TCTRCBR DS CL1 RECV RECORD CONTROL BLOCK 05749000 TCTRCBT DS CL1 TRANS RECORD CONTROL BLOCK 05750000 TCTCOM DS 1F POINTER BACK TO COMMUTATOR 05751000 TDEVSYNC DS 1F SYNCH LOCK 05752000 TDEVREQN DS CL4 FILE ACCESS NAME 05753000 TDEVREQ DS 1A REQUEST BUFFER ADDRESS 05754000 TDEVRESP DS 1A RESPONSE BUFFER 05755000 TDEVRLEN DS AL1 REQUEST LENGTH 05756000 TDEVFUN DS AL1 REQUEST FUNCTION 05757000 TDEVRESV DS AL1 RESERVED BYTE 05758000 TDEVSOPT DS AL1 SUB OPTION BYTE 05759000 TDEVTAG DS 1A TAG ADDRESS 05760000 TDEVFIOA DS 1A FILE I/O AREA 05761000 TDEVLINK DS CL8 LINK NAME 05762000 TSW1 DS AL1 DEVICE SWITCH 1 05763000 TSW2 DS AL1 DEVICE SWITCH 2 05764000 TSW3 DS AL1 DEVICE SWITCH 3 05765000 TSW4 DS AL1 DEVICE SWITCH 4 05766000 TCTTOVM DS CL8 VM OUTPUT DESTINATION 05767000 * 05768000 * NORMAL DEVICE EXTENTION 05769000 * 05770000 TCTTANK DS 1F NEXT TANK TO OUTPUT 05771000 TCTBUFER DS 1F ADDR OF CURRENT BUFFER 05772000 * 05773000 * TNKLM,TNKCT AND BUFLM,BUFCT MUST APPEAR IN SEQ AND STRT 05774000 * ON HALF WORD BOUNDARIES 05775000 TCTTNKLM DS CL1 MAX NUM OF TANKS ASSIGNABLE TO 05776000 TCTTNKCT DS CL1 CURRENT NUM ASSIGNED 05777000 TCTBUFLM DS CL1 MAX NUM OF BUFFERS ASSIGNABLE 05778000 TCTBUFCT DS CL1 CURRENT NUM ASSIGNED 05779000 EJECT 05780000 * 05781000 * TCTSTAT BIT DEFINITIONS 05782000 * 05783000 TCT1052 EQU X'10' TCT STATUS FLAGS FOR 1052 05784000 TCTREL EQU X'04' INTERLOCK RELEASE REQ FOR CONSOLE 05785000 TCTOPEN EQU X'80' TCT OPEN BIT 05786000 TCTACT EQU X'40' ACTION REQUIRED ON THIS TCT 05787000 SPACE 2 05788000 *** TCTECB BIT DEFINITIONS 05789000 SPACE 2 05790000 TCTBUSY EQU X'10' DEVICE BUSY BIT 05791000 EJECT 05792000 BUFDSECT DSECT 05793000 SPACE 1 05794000 *** BUFFER - TELECOMMUNICATIONS BUFFER 05795000 * 05796000 * 0 +-----------------------------------------------+ 05797000 * | BUFCHAIN | 05798000 * 4 +-----------------------+-----------------------+ 05799000 * | BUFCOUNT | BUFSTAT | BUFSTART | 05800000 * 8 +-----------+-----------+-----------------------+ 05801000 * | BUFSTART | BUFBCB | BUFFCS | 05802000 * C +-----------+-----------+-----------------------+ 05803000 * | | 05804000 * | BUFDATA | 05805000 * | | 05806000 * +-----------------------------------------------+ 05807000 * 05808000 *** BUFFER - TELECOMMUNICATIONS BUFFER 05809000 SPACE 1 05810000 BUFBEGIN DS 0F BEGINNING OF THE BUFFER 05811000 BUFCHAIN DC A(0) BUFFER CHAIN FIELD 05812000 BUFCOUNT DS 1H COUNT OF BYTES TO TRANSMIT 05813000 BUFSTAT DS 1C BUFFER STATUS BYTE 05814000 BUFSTART DS CL2 TRANSMISSION CONTROL BYTES 05815000 BUFBCB DS 1C BLOCK CONTROL BYTE 05816000 BUFFCS DS CL2 FUNCTION CONTROL SEQUENCE 05817000 BUFDATA DS 0F DATA PORTION OF TP BUFFER 05818000 SPACE 1 05819000 * BUFFER STATUS BIT DEFINITIONS 05820000 BUFFAKE EQU X'01' DUMMY BUFFER INDICATOR 05821000 BUFRESP EQU X'02' RESPONSE ONLY IN BUFFER 05822000 BUFNAK EQU X'04' NAK RESPONSE BEING SENT 05823000 BUFTEXT EQU X'08' BUFFER CONTAINS TEXT INFORMATION 05824000 BUFUCHEK EQU X'10' UNIT CHECK EXPECTED 05825000 BUFTONAK EQU X'20' T/O ON RD CCW INDICATOR @VA08636 05826000 EJECT 05827000 TANKDSEC DSECT 05828000 SPACE 1 05829000 *** TANKDSECT - UNIT RECORD TANK 05830000 * 05831000 * 0 +-----------------------------------------------+ 05832000 * | TANKCHN | 05833000 * 4 +-----------+-----------+-----------------------+ 05834000 * | TANKRCB | TANKSRCB | TANKCNT | 05835000 * 8 +-----------+-----------+-----------------------+ 05836000 * | | 05837000 * | TANKDATA | 05838000 * | | 05839000 * +-----------------------------------------------+ 05840000 * 05841000 *** TANKDSECT - UNIT RECORD TANK 05842000 SPACE 1 05843000 TANKCHN DC A(0) TANK CHAIN FIELD 05844000 TANKRCB DS 1C TANK RECORD CONTROL BYTE 05845000 TANKSRCB DS 1C TANK SUB-RECORD CONTROL BYTE 05846000 TANKCNT DS 1H COUNT OF DATA BYTES IN TANK 05847000 TANKDATA DS CL200 DATA AREA IN THE TANK @VM01163 05848000 TANKEND DS 0F FORCE NEXT TO WORD BOUNDARY 05849000 EJECT 05850000 COPY SVECTORS 05851000 EJECT 05852000 COPY TASKE 05853000 EJECT 05854000 COPY LINKTABL 05855000 EJECT 05856000 COPY IOTABLE 05857000 SPACE 1 05858000 ECBSKIP EQU X'40' SKIP THIS SYNCH LOCK IN LIST 05859000 EJECT 05860000 COPY TAG 05861000 EJECT 05862000 COPY RSSEQU 05863000 EJECT 05864000 COPY DEVTYPES 05865000 EJECT 05866000 COPY SPOOL 05867000 END DMTSML 05868000