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