NPT TITLE 'DMTNPT (RSCS) VM/370 - RELEASE 6' 00001000
ISEQ 73,80 VALIDATE INPUT FILE SEQUENCEING 00002000
*. 00003000
* MODULE NAME - 00004000
* 00005000
* DMTNPT 00006000
* 00007000
* FUNCTION - 00008000
* 00009000
* THIS RSCS LINE DRIVER PROVIDES SUPPORT FOR THE 2770, 00010000
* 2780, 3770, AND 3780 TYPE NON-PROGRAMMABLE TERMINALS. 00011000
* 00012000
* ATTRIBUTES - 00013000
* 00014000
* NON-REUSABLE 00015000
* 00016000
* ENTRY POINTS - 00017000
* 00018000
* NPTINIT - AT LINE DRIVER INITIALIZATION TIME 00019000
* 00020000
* ENTRY CONDITIONS - 00021000
* 00022000
* R0 - CONTAINS THE LENGTH OF THE PARM FIELD 00023000
* R1 - CONTAINS THE ADDR OF THE START OF THE PARM FIELD 00024000
* R2 - CONTAINS THE ADDR OF THE LINK TABLE ENTRY FOR THIS TASK 00025000
* 00026000
* EXIT CONDITIONS - 00027000
* 00028000
* NORMAL - REQUEST TO DMTREX TO TERMINATE THE TASK 00029000
* ERROR - REQUEST TO DMTREX TO TERMINATE THE TASK 00030000
* 00031000
EJECT 00032000
* 00033000
* CALLS TO OTHER ROUTINES - 00034000
* 00035000
* SEE BEGINNING OF EACH SECTION 00036000
* 00037000
* EXTERNAL REFERENCES - 00038000
* 00039000
* TLINKS - LINK TABLE CHAIN 00040000
* TCOM - COMMON ROUTINE VECTOR TABLE 00041000
* 00042000
* TABLES / WORKAREAS - 00043000
* 00044000
* DEVTABLE - DEVICE TABLE 00045000
* REQBLOCK - DEVICE REQUEST BLOCK 00046000
* 00047000
* 00048000
* REGISTER USAGE - 00049000
* 00050000
* ALL SUBROUTINES IN THE MODULE CONFORM GENERALLY TO THIS USAGE; 00051000
* ANY INDIVIDUAL DEVIATIONS OR EXTENSIONS ARE LISTED WITH THE 00052000
* COMMAND DESCRIPTION 00053000
* 00054000
* GPR0 = WORK 00055000
* GPR1 = WORK 00056000
* GPR2 = REQBLOCK ADDRESSABILITY 00057000
* GPR3 = WORK 00058000
* GPR4 = WORK 00059000
* GPR5 = WORK 00060000
* GPR6 = WORK 00061000
* GPR7 = LINKTABLE ADDRESSABILITY 00062000
* GPR8 = WORK 00063000
* GPR9 = BASE 00064000
* GPR10 =BASE 00065000
* GPR11 =BASE 00066000
* GPR12 =BASE 00067000
* GPR13 =DEVTABLE ADDRESSABILITY 00068000
* GPR14 =RETURN ON INTERNAL CALL 00069000
* GPR15 =COMMON ROUTINE ADDRESSABILITY 00070000
* 00071000
* NOTES - 00072000
* 00073000
* NONE 00074000
* 00075000
* 00076000
*. 00077000
EJECT 00078000
DMTNPT CSECT 00079000
SPACE 3 00080000
NPTSAVE DC 0D'0' BEGINNING OF NPT LINE DRIVER SA 00081000
SPACE 00082000
NPTPSW DC X'FF04',AL2(0),A(NPTINIT) INITIAL PSW FOR DISPATCH 00083000
SPACE 00084000
NPTREG0 DC F'0' INITIAL REGISTER CONTENTS 00085000
NPTREG1 DC F'0' 00086000
NPTREG2 DC F'0' 00087000
NPTREG3 DC F'0' 00088000
NPTREG4 DC F'0' 00089000
NPTREG5 DC F'0' 00090000
NPTREG6 DC F'0' 00091000
NPTREG7 DC F'0' 00092000
NPTREG8 DC F'0' 00093000
NPTREG9 DC A(DMTNPT+X'3000') BASE REGISTER FOR FOURTH PAGE 00094000
NPTREG10 DC A(DMTNPT+X'2000') BASE REGISTER FOR THIRD PAGE 00095000
NPTREG11 DC A(DMTNPT+X'1000') BASE REGISTER FOR SECOND PAGE 00096000
NPTREG12 DC A(DMTNPT) BASE REGISTER FOR FIRST PAGE 00097000
NPTREG13 DC A(0) ADR OF TASK TAB 00098000
NPTREG14 DC F'0' 00099000
NPTREG15 DC A(NPTINIT) ENTRY ADDRESS AT INITIATION 00100000
SPACE 00101000
REQLOCK DC F'0' SYNCH LOCK FOR REQUEST ARRIVAL 00102000
SPACE 00103000
USING DMTNPT,R12 DEFINE FIRST PAGE ADDRESSABILITY 00104000
USING DMTNPT+X'1000',R11 DEFINE SECOND PAGE ADDRESSABILITY 00105000
USING DMTNPT+X'2000',R10 DEFINE THIRD PAGE ADDRESSABILITY 00106000
USING DMTNPT+X'3000',R9 DEFINE THIRD PAGE ADDRESSABILITY 00107000
SPACE 00108000
USING REQBLOCK,R2 ESTABLISH REQUEST BLOCK DSECT ADDRES 00109000
USING DEVTABLE,R13 ESTABLISH DEVICE TABLE DSECT ADDRESS 00110000
USING SVECTORS,0 ESTABLISH LOW CORE ADDRESSABILITY 00111000
USING LINKTABL,R7 GET LINK TABLE ADDRESSABILITY 00112000
USING COMDSECT,R15 GET COMMON ROUTINE LIST ADDR 00113000
EJECT 00114000
*. 00115000
* 00116000
* ENTRY NAME - 00117000
* 00118000
* NPTGET 00119000
* 00120000
* FUNCTION - 00121000
* 00122000
* TO MAINTAIN CYCLIC CONTROL ON THE DMTNPT TASK ON BOTH 00123000
* SENDING AND RECEIVING OPERATIONS. 00124000
* 00125000
* CALLS TO OTHER ROUTINES - 00126000
* 00127000
* NONE 00128000
* 00129000
* OPERATION - 00130000
* 00131000
* 1. TEST FOR DRAIN, HOLD, OR QUEUED MESSAGES. 00132000
* 00133000
* 2. TRY TO GET A FILE TO SEND, IF ONE IS FOUND INITIALIZE 00134000
* TRANSMITTING SECTION. 00135000
* 00136000
* 3. IF ENQ IS RECEIVED FROM A READ INITIAL INITIALIZE 00137000
* TRANSMITTING SECTION. 00138000
* 00139000
* 4. PROCESS PROCESS BUFFERS AND TRANSMIT TO REMOTE STATION. 00140000
* 00141000
* 5. RECEIVED BUFFERS ARE PASSED TO CKBUFF. 00142000
* 00143000
* RESPONSES - 00144000
* 00145000
* NONE 00146000
* 00147000
* ERROR MESSAGES - 00148000
* 00149000
* NONE 00150000
* 00151000
*. 00152000
SPACE 3 00153000
NPTGET EQU * 00154000
TM NPTFLAGS,RENBL ARE WE REENABLING @VA07213 00154300
BO NPTSTART DONT WANT NEW BLOCK @VA07213 00154500
L R7,NPTALINK GET LINK TABLE ADDR 00155000
TM LFLAG,LHOLD IS A LINK HOLD REQUESTED? @VM01139 00156000
BO NPTDINIT YES @VM01139 00157000
TM NPTFLAGS,MSGSEND SENDING A FILE? 00158000
BO NPTGET1 CANT DO ANY OF THIS 00159000
TM LFLAG,LDRAIN IS A LINK DRAIN REQUESTED? 00160000
BO LINEDIS1 YES...EXIT 00161000
TM GETFLAGS,MSGQUED ARE THERE ANY MSGS QUEUED? 00162000
BNO NPTGET1 NO CONTINUE 00163000
BAL R14,MSGPROC GO PROCESS THEM 00164000
EJECT 00165000
NPTGET1 EQU * 00166000
BAL R14,GETBLOCK TRY TO GET SOMETHING TO SEND 00167000
SPACE 1 00168000
* GETBLOCK RETURN HERE IF THERE IS SOMETHING 00169000
B NPTSTART BUFFER IS FILLED - START TALKING 00170000
SPACE 1 00171000
* GETBLOCK RETURN HERE IF THERE IS NOTHING 00172000
* 00172100
* IF LAST READ INIT TIMED OUT TAKE A DELAY TO 00172200
* PREVENT CONTINUOUS POLLING 00172300
* 00172400
TM DEVSENSE,TIMEOUT WAS LAST ERROR A TIMEOUT @VA04358 00172500
BZ NPTDINIT NO, TRY TO MAKE CONNECTION @VA04358 00172600
LA R0,10 TEN SECOND DELAY @VA04358 00172700
BAL R14,TDELAY GO TAKE TEN @VA04358 00172800
* 00172900
NPTDINIT EQU * 00173000
MVC DEVSTART(4),=A(READINIT) READ INITIAL PROGRAM @VA03349 00174000
BAL R14,LINEIO START READING LINE 00175000
TM DEVFLAGS,IOERR DID WE READ ANYTHING SUCCESSFULLY? 00176000
BO NPTGET NO-TRY GETNG A BLK READ AGAIN 00177000
CLI INIT,ENQ WAS IT AN ENQUIRY @VA03349 00178000
BNE NPTDINIT NOPE - READ AGAIN 00179000
EJECT 00180000
* RECEIVING - INITIALIZATION 00181000
SPACE 00182000
NPTACK0 EQU * 00183000
LA R15,RETRYNUM SET THE RETRY REGISTER 00184000
MVC EXPRESP(2),INITACK0 SET UP INITIAL EXP RESP @VA03349 00185000
MVC RESP(2),INITACK0 SET UP INITIAL RESP @VA03349 00186000
MVC DEVSTART(4),=A(RECEIVE) SET UP RESPONSE PROG @VA03349 00187000
BAL R14,LINEIO WRITE DLE,ACK0 AND LISTEN 00188000
TM DEVFLAGS,IOERR EVERYTHING O.K.? 00189000
BNO CKBUFF YES-BLOCK MUST BE IN BUFFER 00190000
TM DEVCSW+4,UC WAS IT A UNIT CHECK? 00191000
BNO NPTEOT NO-MUST BE CONTENTION-TRY AGAIN 00192000
TM DEVSENSE,TIMEOUT IS IT TIMEOUT? 00193000
BO NPTEOT YES-RES THE LNE AND TRY AGAIN 00194000
B NPTNAK OTHERWISE MUST BE LINE ERRORS 00195000
EJECT 00196000
* TRANSMITTING - INITIALIZATION 00197000
SPACE 00198000
NPTSTART EQU * 00199000
MVC EXPRESP(2),INITACK0 SET UP INITIAL EXPECTED RESP@VA03349 00200000
MVC RESP(2),INITACK0 AND INITIAL RESPONSE @VA03349 00201000
NPTSTAR2 EQU * @VA03349 00202000
LA R15,RETRYNUM SET RETRY COUNT 00203000
NPTSTAR1 EQU * 00204000
MVC DEVSTART(4),=A(ENQPROG) ENQ SEQ PROG ADDR TO DEV TABLE 00205000
BAL R14,LINEIO WRITE ENQ AND LISTEN FOR DLE,ACK0 00206000
TM DEVFLAGS,IOERR ANY ERRORS? 00207000
BNO NPTENQOK NOPE - FULL SPEED AHEAD 00208000
TM DEVCSW+4,UC WAS PROBLEM A UNIT CHECK? 00209000
BNO NPTDINIT NO-MUST BE CONTENTION-READ WHILE 00210000
TM DEVSENSE,TIMEOUT IS IT TIMEOUT? 00211000
BNO NPTSTAR2 NO, TRY AGAIN @VA03349 00212000
BCTR R15,0 YES - UPDATE THE TIMEOUT COUNTER 00213000
LTR R15,R15 END OF RETRY? 00214000
BP NPTSTAR1 NO TRY AGAIN 00215000
BAL R14,SENDEOT YES - RESET LINE SENDING EOT 00216000
B NPTSTAR2 AND TRY ONCE MORE @VA03349 00217000
SPACE 00218000
NPTENQOK EQU * 00219000
CLC RESP(2),EXPRESP WAS RESPONSE CORRECT @VA03349 00220000
BE NPTCHAR RIGHT INTO THE BIG LOP IF IT WAS 00221000
CLI RESP,ENQ DID WE GET AN ENQ BACK @VA03349 00222000
BE NPTACK0 YES - SEND DLE,ACK0 @VA04171 00222500
CLI RESP,NAK IS HE NOT READY @VA03349 00223000
BNE CKFEOT NO, CONTINUE @VA03349 00224000
LA R0,5 TAKE A FIVE SECOND REST @VA03349 00225000
BAL R14,TDELAY @VA03349 00226000
B NPTSTAR1 @VA03349 00227000
CKFEOT CLI RESP,EOT WAS IT AN END OF XMISSION @VA03349 00228000
BE NPTDINIT YES, START FROM THE TOP @VA03349 00229000
CLC RESP(2),=AL1(DLE,RVI) IS HIS BUFFER FULL OF DATA@VA03349 00230000
BE NPTACK0 GO LET HIM TALK @VA03349 00231000
B NPTSTAR1 GARBAGE RESPONSE, ENQ AGAIN @VA03349 00232000
SPACE 00233000
NPTCHAR EQU * 00234000
XI EXPRESP+1,X'11' SWITCH THE EXPECTED RESP @VA03349 00235000
DORESEL EQU * @VA03349 00236000
TM NPTFLAGS,MSGSEND IS THERE AN ACTIVE FILE @VA03349 00237000
BZ MSGDOA NO, MUST BE TROUBLE IN MSG SEND @VA04171 00238500
TM DEVFEAT,REM2780 IS THE REM.DEV. A 2780? 00239000
BO NO2770 YES - SKIP NEXT CODE 00240000
TM DEVFEAT,REM3770 IS IT A 3770 @VA03349 00241000
BZ NOT3770 NO, USE DC1 SELECTION @VA03349 00242000
TM GETFLAGS,PRNTSEND SENDING A PRINT FILE @VA03349 00243000
BZ NOT3770A NO, USE PUNCH SELECTION @VA03349 00244000
* 00245000
* 3770 HAS TWO PRINTERS, CONSOLE PRINTER AND LINE PRINTER. 00246000
* CODE SELECTS THE LINE PRINTER AS THE SUPPORTED PRINTER. 00247000
* 00248000
MVC DCX+1(1),PRTSEL SELECT THE SPECIFIED PRINTER @VA04171 00249500
B REL2 @VA03349 00250000
NOT3770 EQU * @VA03349 00251000
TM DEVFEAT,REMPUNCH PUNCH UNIT INSTALLED @VA03742 00252000
BNO NPTDSEL NO...DONT SELECT @VA03742 00253000
MVI DCX+1,DC1 PRINTER SELECTION 00254000
TM GETFLAGS,PRNTSEND PRINTER? 00255000
BO REL2 YES - GO TO SEND IT 00256000
NOT3770A EQU * @VA03349 00257000
MVI DCX+1,DC2 NO - PUNCH SELECTION 00258000
OI SELFLAGS,PCHSEL INDICATE SELECTING THE PUNCH @VA04359 00258500
REL2 EQU * 00259000
LA R15,SELBUF SET SELECT BUFFER ADDR @VA03349 00260000
MVC 0(L'DCX,R15),DCX SET BUFFER FOR 2770 00261000
LA R15,L'DCX AND THE LENGTH 00262000
B REL1 AND CONTINUE 00263000
EJECT 00264000
NO2770 EQU * 00265000
MVI INDEVSEL+2,X'61' PRINTER SELECTION 00266000
TM GETFLAGS,PRNTSEND PRINTER? 00267000
BO REL3 YES SEND IT 00268000
MVI INDEVSEL+2,X'F4' PUNCH SELECTION 00269000
OI SELFLAGS,PCHSEL INDICATE SELECTING THE PUNCH @VA03349 00270000
REL3 EQU * 00271000
LA R15,L'INDEVSEL GET THE LENGTH 00272000
LA R14,SELBUF GET SELECT BUFFER ADDR @VA03349 00273000
MVC 0(L'INDEVSEL,R14),INDEVSEL BUFFER FOR 2780 00274000
REL1 EQU * 00275000
STH R15,SELPROG+6 SET THE BYTE COUNT @VA03349 00276000
MVI TRANSMIT+8,X'03' NOP THE TRANSPARENT XMIT @VA03349 00277000
LA R15,SELBUF SET THE SELECTION ADDRESS @VA03349 00278000
STCM R15,B'0111',SELPROG+1 @VA03349 00279000
REL1A MVC DEVSTART,=A(SELPROG) SET UP TO SEND TO DEVICE @VA03349 00280000
BAL R14,LINEIO GO SEND THE DEVICE SELECTION @VA03349 00281000
BAL R8,SENDVRFY CHECK THE OPERATION @VA03349 00282000
SPACE 1 @VM01140 00283000
NPTDSEL EQU * @VM01140 00284000
TM GETFLAGS,PRNTSEND SENDING PRINT? @VA03112 00285000
BNZ NOTPCHS YES, SKIP @VA03349 00286000
TM DEVFEAT,TRANSP DEVICE HAVE TRANSPARENCY @VA03349 00287000
BZ NPTDSELA NO, NO TRANSPARENT ENDING @VA03349 00288000
MVI TRANSMIT+8,X'01' MUST WRITE ENDING SEQ @VA03349 00289000
NPTDSELA NI SELFLAGS,X'FF'-PCHSEL FINISHED SELECTING PUNCH @VA03349 00290000
EJECT 00291000
* TRANSMITTING - WORK SECTION 00292000
NOTPCHS DS 0H @VA07213 00293200
TM NPTFLAGS,RENBL ARE WE RE-ENABLING @VA07213 00293400
BO NOTPCHSA YES RESEND THE BUFFER @VA07213 00293600
TM SELFLAGS,RSELECT IS IT RESELECTION @VA07213 00293800
BZ NPTCHARG NO, NORMAL SEQUENCE @VA03349 00294000
NOTPCHSA NI SELFLAGS,X'FF'-RSELECT CLEAR THE RESELECTION @VA03349 00295000
NI NPTFLAGS,X'FF'-RENBL TURN OFF REENABLE BIT @VA07213 00295500
B NPTTALK CONTINUE FROM WHERE LEFT OFF @VA03349 00296000
SPACE 00297000
NPTCHARG EQU * 00298000
L R7,NPTALINK GET LINK TABLE ENTRY 00299000
TM LFLAG,LHOLD ARE WE HELD? 00300000
BO NPTCHRG1 YEP - FORGET IT 00301000
BAL R14,BUFFINIT GO TO INITIALIZE THE OUT BUFF 00302000
BAL R14,GETBLOCK AND GET A NEW ONE 00303000
* GETBLOCK 00304000
B GETTALK RETURN HERE IN STANDARD OPERATION 00305000
* 00306000
* RETURN HERE IN CASE OF END OF FILE 00307000
* 00308000
LA R2,RDRBLK SET POINTER TO READ-PRINTER/PUNCH 00309000
TM GETFLAGS,PRNTSEND SENDING A PRINT FILE @VA03349 00311000
BNZ NPTCHRG1 YES, NO RESET OF PUNCH @VA03349 00312000
MVI TRANSMIT+8,X'03' NOP THE TRANSPARENT WRITE @VA03349 00313000
NI SELFLAGS,X'FF'-(PCHSEL+RSELECT) @VA03349 00314000
NPTCHRG1 EQU * 00315000
LA R13,LINE RESET POINTER TO SEND EOT 00316000
B NPTEOT AND GO TO SEND IT 00317000
SPACE 00318000
GETTALK EQU * 00319000
SPACE 00320000
NPTTALK EQU * 00321000
TM SELFLAGS,RSELECT RESELECTION AFTER INT. @VA03349 00322000
BNO CKPCHL NO, GO CHECK IF SEL PUNCH @VA03349 00323000
TM GETFLAGS,PRNTSEND SENDING A PRINT FILE @VA03349 00324000
BNO DORESEL NO, RESELECT PUNCH @VA03349 00325000
TM DEVFEAT,REM3770 IS IT A 3770 @VA03349 00326000
BZ NOTPCHSA NO, NO RESELECT @VA03349 00327000
B DORESEL GO DO A RESELECT @VA03349 00328000
CKPCHL TM SELFLAGS,PCHSEL SELECTING THE PUNCH @VA03349 00329000
BO REL1A YES, GO DO IT AGAIN @VA03349 00330000
TM NPTFLAGS,MSGSEND IS THERE AN ACTIVE FILE @VA04171 00330300
BZ MSGDOA NO, MUST BE TROUBLE IN MSG SEND @VA04171 00330600
MVC DEVSTART,=A(TRANSMIT) PROG TO SEND TO DEVICE @VA03349 00331000
BAL R14,LINEIO GO DO THE IO @VA03349 00332000
BAL R8,SENDVRFY CHECK THE OPERATION @VA03349 00333000
B NPTCHARG GO LOOK FOR MORE TO SEND @VA03349 00334000
* 00335000
NPTEOT EQU * 00336000
MVI ETBTRA+1,ETB SET ETB 00337000
BAL R14,SENDEOT GO TO SEND EOT 00338000
L R7,NPTALINK GET LINK TABLE ADDR 00339000
TM LFLAG,LHOLD REMOTE TERMINAL DRAINED 00340000
BNO NPTDINIT NOPE - GO BACK TO READ INITIAL 00341000
LINEDIS EQU * 00342000
L R7,NPTALINK GET LINK TABLE ADDR 00343000
TM LFLAG,LDRAIN IS TERMINATION REQUIRED? 00344000
BNO NPTDINIT NO - GO TO WORK 00345000
B LINEDIS1 YES - DISABLE THE LINE 00346000
EJECT 00347000
SPACE 00348000
*. 00349000
* 00350000
* ENTRY NAME - 00351000
* 00352000
* SENDEOT 00353000
* 00354000
* FUNCTION - 00355000
* 00356000
* THIS ROUTINE SENDS THE BSC END OF TRANSMISSION CHARACTER 00357000
* (EOT) ON THE LINE TO THE REMOTE TERMINAL. 00358000
* 00359000
* CALLS TO OTHER ROUTINES - 00360000
* 00361000
* NONE 00362000
* 00363000
* OPERATION - 00364000
* 00365000
* 1. INITIATE LINEIO TO SEND EOT PROGRAM 00366000
* 00367000
* 2. REPEAT OPERATION UNTIL I/O OPERATION SUCCESSFUL 00368000
* 00369000
* ENTRY CONDITIONS: 00370000
* 00371000
* IN REG. 14 THE RETURN ADDRESS. 00372000
* 00373000
* EXIT CONDITIONS: 00374000
* 00375000
* NONE 00376000
* 00377000
* NOTE: 00378000
* 00379000
* THE REG. 13 IS USED BUT NOT SAVED (POINTER TO THE LINE DEVICE 00380000
* BLOCK). 00381000
* 00382000
* RESPONSES - 00383000
* 00384000
* NONE 00385000
* 00386000
* ERROR MESSAGES - 00387000
* 00388000
* NONE 00389000
* 00390000
*. 00391000
EJECT 00392000
SENDEOT DS 0H 00393000
LA R13,LINE LINE POINTER 00394000
ST R14,SAVEOT SAVE RETURN ADDRESS 00395000
RESNDEOT EQU * 00396000
MVC DEVSTART(4),=A(EOTPROG) MOVE EOT PROG ADDR TO TABLE 00397000
BAL R14,LINEIO SEND THE EOT 00398000
TM DEVFLAGS,IOERR WAS THERE ANY TROUBLE WITH THAT? 00399000
BO RESNDEOT TRY IT AGAIN 00400000
MVC EXPRESP(2),INITACK0 SET UP INITIAL EXPECTED RESP@VA03349 00401000
MVC RESP(2),INITACK0 SET UP INITIAL RESP @VA03349 00402000
L R14,SAVEOT RESTORE REG. 14 00403000
BR R14 AND RETURN TO CALLER 00404000
SPACE 00405000
SAVEOT DC F'0' SAVE AREA 00406000
EJECT 00407000
*. 00408000
* 00409000
* ENTRY NAME - 00410000
* 00411000
* BUFFINIT 00412000
* 00413000
* FUNCTION - 00414000
* 00415000
* THIS ROUTINE INITIALIZES THE LINE OUTPUT BUFFER WITH THE 00416000
* CORRECT BSC CHARACTER SET, DEPENDING ON THE TYPE OF THE 00417000
* OUTPUT FILE AND ON THE FEATURES AVAILABLE AT THE TERMINAL. 00418000
* 00419000
* CALLS TO OTHER ROUTINES - 00420000
* 00421000
* NONE 00422000
* 00423000
* OPERATION - 00424000
* 00425000
* 1. INITIALIZE OUTPUT BUFFER WITH DLE,STX FOR TRANS OPERATION. 00426000
* 00427000
* 2. OR STX FOR NON-TRANS OPERATION. 00428000
* 00429000
* ENTRY CONDITION: 00430000
* 00431000
* IN REG. 14 THE RETURN ADDRESS. 00432000
* THE FLAG BYTES DEVFEAT AND GETFLAGS PROPERLY SET. 00433000
* 00434000
* EXIT CONDITIONS: 00435000
* 00436000
* NONE 00437000
* 00438000
* NOTE: 00439000
* 00440000
* THE REG. 3 AND 4 ARE USED BUT NOT SAVED. 00441000
* 00442000
* RESPONSES - 00443000
* 00444000
* NONE 00445000
* 00446000
* ERROR MESSAGES - 00447000
* 00448000
* NONE 00449000
* 00450000
*. 00451000
EJECT 00452000
BUFFINIT DS 0H 00453000
LA R5,1 BYTES COUNT 00454000
L R6,LINEBUFF BUFFER POINTER 00455000
TM DEVFEAT,TRANSP TRANSPARENCY FEATURE? 00456000
BNO NOT NOPE 00457000
TM GETFLAGS,PRNTSEND YES - PRINT FILE? 00458000
BO NOT YES 00459000
MVI 0(R6),DLE SET START TRANSP. INTO THE BUFFER 00460000
LA R6,1(R6) UPDATE BUFFER POINTER 00461000
LA R5,1(R5) AND BYTES COUNT 00462000
NOT EQU * 00463000
MVI 0(R6),STX PUT STX INTO THE BUFFER 00464000
STH R5,BYTSCNT STORE THE BYTES COUNT 00465000
LA R6,1(R6) UPDATE THE BUFFER POINTER 00466000
ST R6,STARTLIN AND SAVE IT 00467000
XC RECNT(2),RECNT CLEAR THE RECORD COUNT 00468000
BR R14 AND RETURN TO CALLER 00469000
EJECT 00470000
*. 00471000
* 00472000
* ENTRY NAME - 00473000
* 00474000
* XECUTE 00475000
* 00476000
* FUNCTION - 00477000
* 00478000
* THIS ROUTINE REQUESTS THE SUPERVISOR TO EXECUTE I/O 00479000
* OPERATIONS. AFTER INITIATING THE I/O OPERATION, THE 00480000
* ROUTINE WAITS FOR EITHER A COMMAND TO BE ENTERED OR THE 00481000
* COMPLETION OF THE REQUESTED I/O OPERATION. 00482000
* 00483000
* THIS ROUTINE ALSO REQUESTS THE SUPERVISOR TO ESTABLISH 00484000
* A TIME DELAY. THE ROUTINE THEN WAITS FOR THE TIME DELAY 00485000
* PERIOD TO EXPIRE. 00486000
* 00487000
* CALLS TO OTHER ROUTINES - 00488000
* 00489000
* DMTIOMRQ - TO INITIATE AN I/O OPERATION 00490000
* DMTWAT - TO WAIT FOR THE COMPLETION OF THE I/O OPERATION 00491000
* DMTASY - ESTABLISH A TIME DELAY 00492000
* 00493000
* OPERATION - 00494000
* 00495000
* 1. INITIATE I/O OPERATION ON DEVICE SPECIFIED BY THE DEVICE 00496000
* BLOCK POINTED TO BY R13. 00497000
* 00498000
* 2. WAIT FOR COMPLETION OF I/O OR CMD SYNCH LOCK TO BE POSTED. 00499000
* 00500000
* 3. IF COMMAND HAS BEEN ENTERED, PROCESS IT. 00501000
* 00502000
* 4. IF NOT, RETURN CONTROL TO CALLER. 00503000
* 00504000
* 5. INITIATE A TIME DELAY. 00505000
* 00506000
* 6. WAIT FOR TIME EXPIRATION. 00507000
* 00508000
* ENTRY CONDITIONS: 00509000
* 00510000
* IN REG. 13 DEVICE BLOCK POINTER 00511000
* IN REG. 14 RETURN ADDRESS. 00512000
* 00513000
* TIME DELAY 00514000
* 00515000
* REG 0 - DELAY TIME IN SECONDS (APPROX) 00516000
* REG 14 - RETURN ADDRESS 00517000
* 00518000
* EXIT CONDITIONS: 00519000
* 00520000
* THE EXIT TO THE TASK ABORT ROUTINE IS TAKEN IN CASE 00521000
* OF UNRECOVERABLE ERRORS. 00522000
* 00523000
* NOTE: 00524000
* 00525000
* NONE 00526000
* 00527000
* RESPONSES - 00528000
* 00529000
* NONE 00530000
* 00531000
* ERROR MESSAGES - 00532000
* 00533000
* NONE 00534000
* 00535000
*. 00536000
SPACE 3 00537000
XECUTE DC 0H'0' 00538000
STM R14,R1,XECSAVE SAVE CALLER'S REGISTERS 00539000
XC DEVLOCK(4),DEVLOCK CLEAR THE SYNCH LOCK 00540000
LA R1,0(R13) R1=ADDRESS OF THE DEVICE I/O TAB 00541000
L R15,IOREQ R15=ADDR OF SYS I/O REQ ENT 00542000
BALR R14,R15 REQUEST THE I/O OPERATION 00543000
ST R1,XECLIST STORE SYNCHLOCK ADDR IN WAIT LIST 00544000
XECWAIT EQU * 00545000
LA R1,XECLIST GET WAIT LIST ADDR 00546000
L R15,WAITREQ R15=ADDRESS OF SYS WAIT ROUT 00547000
BALR R14,R15 WAIT FOR COMPLETION OF THE I/O REQ 00548000
TM CMDECB,X'80' WAS A COMMAND ENTERED? 00549000
BNO XECIOD NO...CONTINUE 00550000
XC CMDECB(4),CMDECB CLEAR SYNCH LOCK 00551000
BAL R14,CMDPROC EXECUTE COMMAND 00552000
XECIOD EQU * 00553000
TM DEVLOCK,X'80' I/O DONE? 00554000
BNO XECTIME NO, CHECK FOR A TIMER INTP @VA03349 00555000
TM DEVSIOCC,X'02' DID WE GET A COND CODE 2 OR 3? 00556000
BC 7,NPTERR1 EXIT WITH ERROR 00557000
NI NPTFLAGS,X'FF'-TDLY SHUT OFF THE TIMER @VA03349 00558000
LM R14,1,XECSAVE RESTORE CALLER'S REGISTERS 00559000
BR R14 AND RETURN TO THE CALLER 00560000
SPACE 00561000
XECSAVE DC 4F'0' XECUTE REGISTER SAVE AREA 00562000
SPACE 1 00563000
XECLIST DC A(0) IO SYNCH LOCK 00564000
DC X'00',AL3(CMDECB) CMD SYNCH LOCK ADDR @VA03349 00565000
DC X'80',AL3(TIMERECB) TIMER SYNCH LOCK ADDR @VA03349 00566000
SPACE 2 00567000
* THIS ROUTINE GAINS CONTROL WHEN THE TIME DELAY EXPIRES. 00568000
* IT CLEARS FLAGS AND RETURNS TO THE CALLER. 00569000
SPACE 2 00570000
XECTIME TM TIMERECB,X'80' TIMER WAIT ENDED @VA03349 00571000
BNO XECWAIT NO, WAIT AGAIN @VA03349 00572000
XC TIMERECB(4),TIMERECB CLEAR THE SYNCH LOCK @VA03349 00573000
TM NPTFLAGS,TDLY EXPECTING A TIME INTERRUPT @VA03349 00574000
BNO XECWAIT NO, WAIT AGAIN @VA03349 00575000
NI NPTFLAGS,X'FF'-TDLY TURN THE TIME DELAY OFF @VA03349 00576000
LM R14,R3,TDSAVE RESTORE REGISTERS @VA03349 00577000
BR R14 RETURN @VA03349 00578000
SPACE 2 00579000
* THIS ROUTINE ESTABLISHES THE TIME DELAY BY A CALL TO DMTASY, 00580000
* PASSING THE DELAY TIME IN REG 0. 00581000
* IF A NEED ARISES THE ROUTINE CAN BE MODIFIED SO THAT EXECUTION 00582000
* CONTINUES DURING THE TIME PERIOD INSTEAD OF WAITING FOR EXPIRATION. 00583000
SPACE 2 00584000
TDELAY STM R14,R3,TDSAVE SAVE CALLERS REGS @VA03349 00585000
XC DEVLOCK(4),DEVLOCK MAKE SURE I/O NOT POSTED @VA03349 00586000
STCK CURCLOCK GET THE CURRENT TIME @VA03349 00587000
LM R2,R3,CURCLOCK SET UP THE REQUESTED DELAY @VA03349 00588000
ALR R2,R0 @VA03349 00589000
LA R1,AXSALERT SET INT RETURN ADDRESS @VA03349 00590000
L R0,TDCODE INDICATE A TIMER REQUEST @VA03349 00591000
OI NPTFLAGS,TDLY INDICATE TIME DELAY IS ACTIVE @VA03349 00592000
L R15,ASYNREQ GO SET THE DELAY @VA03349 00593000
BALR R14,R15 @VA03349 00594000
B XECWAIT GO WAIT ON THE TIMER @VA03349 00595000
SPACE 2 00596000
DS 0D @VA03349 00597000
CURCLOCK DC 2F'0' CURRENT CLOCK VALUE @VA03349 00598000
TDSAVE DC 6F'0' TIME DELAY SAVE AREA @VA03349 00599000
TIMERECB DC F'0' @VA03349 00600000
TDCODE DC X'10040000' INDICATES A REQUEST FOR TIMER @VA03349 00601000
EJECT 00602000
*. 00603000
* 00604000
* ENTRY NAME - 00605000
* 00606000
* LINEIO 00607000
* 00608000
* FUNCTION - 00609000
* 00610000
* THIS ROUTINE EXECUTE (CALLING XECUTE) I/O OPERATIONS 00611000
* ON THE BSC LINE AND CHECKS THE FINAL STATE, CONSEQUENTLY 00612000
* SETTING THE IOERR FLAG IN THE DEVFLAG BYTE. 00613000
* 00614000
* CALLS TO OTHER ROUTINES - 00615000
* 00616000
* NONE 00617000
* 00618000
* OPERATION - 00619000
* 00620000
* 1. INITIATE LINEIO VIA A CALL TO XECUTE. 00621000
* 00622000
* 2. IF I/O OPERATION COMPLETED WITHOUT AN ERROR, RETURN 00623000
* TO CALLER. 00624000
* 00625000
* 3. RECORD THE LINE ERROR AND TERMINATE THE TASK IF A SEVERE 00626000
* ERROR. 00627000
* 00628000
* 4. IF A RECOVERABLE ERROR, SET THE IOERR FLAG AND RETURN 00629000
* TO CALLER. 00630000
* 00631000
* ENTRY CONDITIONS: 00632000
* 00633000
* IN REG. 13 THE LINE DEVICE BLOCK POINTER. 00634000
* IN REG. 14 THE RETURN ADDRESS. 00635000
* 00636000
* EXIT CONDITIONS: 00637000
* 00638000
* THE TASK ABORT ROUTINE IS ENTERED IN CASE OF UNRECOVERABLE 00639000
* ERRORS. THE LINE IS RESTARTED (->LINEDROP) IN SOME CRITICAL 00640000
* SITUATIONS. 00641000
* 00642000
* NOTE: 00643000
* 00644000
* NONE 00645000
* 00646000
* RESPONSES - 00647000
* 00648000
* NONE 00649000
* 00650000
* ERROR MESSAGES - 00651000
* 00652000
* NONE 00653000
* 00654000
*. 00655000
SPACE 3 00656000
LINEIO DC 0H'0' 00657000
STM R14,R15,LINESAVE SAVE CALLER'S REGS 00658000
LINERTRY EQU * 00659000
NI DEVFLAGS,X'FF'-IOERR TURN OFF POSSIBLE LEFTOVER FLAG 00660000
BAL R14,XECUTE EXECUTE THE DEV BLOCK AS IT STANDS 00661000
L R15,AKLOGIT GET ADDRESS OF LOG ROUTINE @VA03349 00662000
BALR R14,R15 GO LOGIT @VA03349 00663000
CLI DEVSIOCC,X'00' CHECK THE COND CODE ON THE START 00664000
BC 7,NPTERROR EXIT WITH ERROR 00665000
TM DEVCSW+5,X'BF' LINE WAS STARTED-ANYTHING BAD? 00666000
BC 7,NPTERROR EXIT WITH ERROR 00667000
TM DEVCSW+4,X'F0' CHECK FIRST BYTE OF STATUS, TOO 00668000
BC 7,NPTERROR EXIT WITH ERROR 00669000
TM DEVCSW+4,UC+UE WERE THERE ANY ERRORS? 00670000
BZ LINEXIT NO-RETURN IMMEDIATELY WITH GOOD NEWS 00671000
L R15,DEVCSW REG.15 = ADDRESS OF LAST CCW + 8 00672000
S R15,=F'8' BACK UP TO THE FAILING CCW 00673000
TM DEVCSW+4,UC IS IT UNIT EXCEPTION ONLY? 00674000
BZ LINEXCPT YEP - CHECK OUT CCW OPERATION CODE 00675000
TM DEVSENSE,CMDREJ+BUSOUT+EQCHK IS IT SOMETHING GHASTL 00676000
BC 7,NPTERROR EXIT WITH ERROR 00677000
TM DEVSENSE,INTREQ IS IT INTERVENTION REQUIRED? 00678000
BO LINEDROP IF SO, RE-INITIALIZE AND READ INIT 00679000
TM DEVSENSE,TIMEOUT ON THE OTHER HAND, IS IT TIMEOUT? 00680000
BNO LINERR1 IF IT ISN'T, THEN ERROR 00681000
BAL R14,TRTIMOT COUNT TIMEOUT 00682000
B LINERR NO DATA - MAYBE TRY IT AGAIN @VA03349 00685000
SPACE 00686000
LINERR1 EQU * 00687000
BAL R14,TRERR COUNT THE ERROR 00688000
B LINERR AND CONTINUE 00689000
EJECT 00690000
LINEXCPT EQU * 00691000
CLI 0(R15),X'01' WAS UNIT EXCEPTION ON A WRITE? 00692000
BNE LINEXIT NO-PROBABLY READ EOT-NORMAL RETURN 00693000
MVI DEVSENSE,X'00' CLEAR OLD SENSE INFO @VA03349 00694000
MVC DEVSAVE(24),DEVTABLE SAVE CONTENTS OF DEVICE BLOCK 00695000
MVC DEVSTART(4),=A(DUMYREAD) SET CHAN PROG TO RESET CCW 00696000
BAL R14,XECUTE STRAIGHTEN OUT THE BSC LOGIC 00697000
L R15,AKLOGIT GET ADDRESS OF LOG ROUTINE @VA03349 00698000
BALR R14,R15 GO LOGIT @VA03349 00699000
CLI DEVSIOCC,X'00' DID IT GET STARTED O.K.? 00700000
MVC DEVTABLE(24),DEVSAVE RESTORE DEVICE BLOCK 00701000
BNE LINERTRY NO - TRY IT AGAIN FROM THE TOP 00702000
LINERR EQU * 00703000
OI DEVFLAGS,IOERR SIGNAL LINE I/O ERROR TO CALLER 00704000
LINEXIT EQU * 00705000
LM R14,R15,LINESAVE RESTORE CLOBBERED REGISTERS 00706000
BR R14 AND RETURN TO THE CALLER 00707000
SPACE 00708000
LINESAVE DC 2F'0' LINEIO SAVE AREA 00709000
DEVSAVE DC 6F'0' SAVE AREA FOR DEVICE BLOCK 00710000
RCOUNT DC F'0' NUMBER OF BYTES TRANSFERRED @VA03349 00711000
AKLOGIT DC A(KLOGIT) ADDRESS OF LOG ROUTINE @VA03349 00712000
EJECT 00713000
*. 00714000
* 00715000
* ENTRY NAME - 00716000
* 00717000
* GETBLOCK 00718000
* 00719000
* FUNCTION - 00720000
* 00721000
* THIS ROUTINE PREPARES THE LINE OUTPUT BUFFER TO BE TRANSMITTED 00722000
* TO THE REMOTE TERMINAL. 00723000
* 00724000
* CALLS TO OTHER ROUTINES - 00725000
* 00726000
* NONE 00727000
* 00728000
* OPERATION - 00729000
* 00730000
* 1. IF NEEDED OPEN A NEW FILE TO TRANSMIT VIA A CALL TO 00731000
* AXSGET. 00732000
* 00733000
* 2. TEST FOR A READER COMMAND PENDING BY CHECKING RDRCMD BYTE. 00734000
* 00735000
* 3. GET A RECORD TO TRANSMIT VIA CALL TO MAKEBLOC. 00736000
* 00737000
* 4. PACK THE RECORD INTO TRANSMISSION BUFFER. 00738000
* 00739000
* 5. IF EOF PURGE THE FILE AND RETURN WITH EOF CONDITION. 00740000
* 00741000
* ENTRY CONDITIONS: 00742000
* 00743000
* IN REG. 14 THE RETURN ADDRESS. 00744000
* 00745000
* EXIT CONDITIONS: 00746000
* 00747000
* NONE 00748000
* 00749000
* NOTE: 00750000
* 00751000
* THE RETURN IS AT THE ADDRESS SPECIFIED IN THE REG. 14 00752000
* IF THE LINE OUTPUT BUFFER IS READY TO SEND. 00753000
* THE RETURN IS AT THE ADDRESS SPECIFIED IN REG. 14 PLUS FOUR 00754000
* IF NO OUTPUT FILES ARE READY FOR TRANSMISSION, OR IF 00755000
* THE END OF FILE CONDITION IS REACHED FOR THE FILE 00756000
* ACTUALLY PROCESSED. 00757000
EJECT 00758000
* 00759000
* RESPONSES - 00760000
* 00761000
* DMTNPT146I SENDING: FILE 'SPOOLID' ON LINK 'LINKID', 00762000
* REC NNNNNN 00763000
* DMTNPT147I SENT: FILE 'SPOOLID' ON LINK 'LINKID' 00764000
* DMTNPT580I FILE 'SPOOLID' PROCESSING TERMINATED 00765000
* DMTNPT611I LINK 'LINKID' FILE TRANSMISSION SUSPENDED 00766000
* DMTNPT510I FILE 'SPOOLID' BACKSPACED 00767000
* DMTNPT600I FILE 'SPOOLID' FORWARD SPACED 00768000
* 00769000
* ERROR MESSAGES - 00770000
* 00771000
* DMTNPT581E FILE 'SPOOLID' NOT ACTIVE 00772000
* DMTNPT936E NO REMOTE PUNCH AVAILABLE ON LINK 'LINKID' -- 00773000
* FILE 'SPOOLID' PURGED 00774000
* 00775000
*. 00776000
SPACE 3 00777000
GETBLOCK EQU * 00778000
USING TAG,R1 GET TAG ADDRESSABILTIY 00779000
STM R13,R15,GETSAVE SAVE CALLER REGISTERS 00780000
SPACE 00781000
* STANDARD WORK SECTION 00782000
SPACE 00783000
GETNEW EQU * 00784000
TM GETFLAGS,BUFEMPTY THE BUFFER IS EMPTY? 00785000
BZ GETLINE NO - GO TO SEND IT 00786000
SPACE 00787000
LA R2,RDRBLK SET POINTER TO READER REQ. BLOCK 00788000
TM NPTFLAGS,HEADFLAG SENDING HEADER? 00789000
BZ GETEXEC NOPE 00790000
LA R14,PACKBLK YES- SET REENTRY POINT 00791000
B HEADPREP AND GO TO GET AN HEADER LINE 00792000
SPACE 00793000
GETEXEC EQU * 00794000
TM RDEVFLAG,FILACTIV AN ACTIV FILE NOW? 00795000
BNO GETFILE NO 00796000
CLI RDRCMD,X'00' ANY COMMAND PENDING? 00797000
BE GETEXEC1 NO CONTINUE 00798000
TM RDRCMD,RBACKCNT BACKSPAC COUNT? 00799000
BO GETBKUP YES PROCESS IT 00800000
TM RDRCMD,RFWDCNT FORWARD SPACE COUNT? 00801000
BO GETGOFWD YES PROCESS IT 00802000
TM RDRCMD,RBACKFIL BACKSPAC FILE? 00803000
BO GETBKFIL GO DO IT 00804000
TM RDRCMD,RFLSHALL FLUSH ALL? 00805000
BNO GETLOP3 NO CONTINUE 00806000
OI RDEVSOPT,ALL INDICATE FLUSH ALL IN RDR 00807000
B GETFLUSH AND CONTINUE @VM01139 00808000
EJECT 00809000
GETLOP3 EQU * 00810000
TM RDRCMD,RFLSHOLD FLUSH AND HOLD? 00811000
BNO GETFLCPY MIGHT BE FLUSH COPY @VM01139 00812000
OI RDEVSOPT,HOLD INDICATE FLUSH AND HOLD 00813000
B GETFLUSH AND GET RID OF FILE 00814000
SPACE 1 @VM01139 00815000
GETFLCPY EQU * @VM01139 00816000
TM RDRCMD,RFLSHCPY FLUSH COPY? @VM01139 00817000
BO GETFLUSH YES..DO IT @VM01139 00818000
SPACE 1 00819000
GETEXEC1 EQU * 00820000
TM NPTFLAGS,ETXSEND ABOUT TO SEND ETX? @VA03640 00821000
BO GETEXEC4 YES @VA03640 00822000
TM GETFLAGS,EOF EOF ON LAST READ? 00823000
BO GETPURGE YES - GO TO PURGE THE FILE 00824000
SPACE 00825000
GETEXEC2 EQU * 00826000
LA R2,RDRBLK GET READER REQUEST BLOCK ADDR 00827000
BAL R14,MAKEBLOC OTHERWISE GET A NEW BLOCK 00828000
BNZ GETEXEC3 EOF 00829000
CLI BUFUNPK,X'03' TAG RECORD? 00830000
BE GETEXEC2 YES..IGNORE IT 00831000
B PACKBLK PROCESS IT 00832000
SPACE 00833000
GETEXEC3 EQU * 00834000
NI RDRCMD,255-RFLSHCPY-RFLSHOLD-RFLSHALL RESET CMD FLAGS 00835000
TM GETFLAGS,PRNTSEND SENDING PRINT? @VA03640 00836000
BZ GETEXEC4 NO @VA03640 00837000
OI GETFLAGS,EJECT+IMCMD SET PAGE EJECT & IMMED CMD @VA03640 00838000
MVC BUFUNPK(2),=X'8B40' SKIP TO CHANNEL 1 @VA03349 00839000
LA R15,2 NUMBER OF BYTES @VA03640 00840000
STH R15,BUFCNT @VA03640 00841000
NI GETFLAGS,X'FF'-BUFEMPTY INDIC. BUFFER FULL @VA03640 00842000
B PACKBLK PROCESS THE PAGE EJECT @VA03640 00843000
SPACE 1 00844000
GETEXEC4 EQU * @VA03640 00845000
NI NPTFLAGS,X'FF'-ETXSEND RESET ETX FLAG @VA03640 00846000
OI RDEVFLAG,MSGON SET UP TO CONFIRM TRANSMISSION LATER 00847000
B GETEOF AND GO TO CLOSE PROPERLY 00848000
EJECT 00849000
GETFLUSH EQU * 00850000
NI RDRCMD,255-RFLSHCPY-RFLSHOLD-RFLSHALL RESET CMD FLAGS 00851000
MVC MSGLINK(8),RDRCMDLK MOVE IN THE RESPONSE LINKID 00852000
CLC CMDFID(4),RDEVFID IS THIS THE CORRECT FILE? 00853000
BNE GETFLSHE NO..ERROR 00854000
MSG 580,RDEVFID WRITE THE FLUSH MSG 00855000
B GETEXEC3 GO END THE FILE @VA03749 00856000
SPACE 1 00857000
GETFLSHE EQU * 00858000
MSG 581,CMDFID WRITE ERROR MSG 00859000
B GETEXEC1 AND CONTINUE 00860000
EJECT 00861000
* CLOSE AND PURGE SECTION 00862000
GETPURGE EQU * 00863000
NI NPTFLAGS,X'FF'-MSGSEND RESET SENDING FLAG 00864000
BAL R14,AXSPURGE GET RIDE OF FILE 00865000
NI GETFLAGS,X'FF'-PRNTSEND-EOF RESET FILE TYPE AND EOF 00866000
TM RDEVFLAG,MSGON SHOULD WE CONFIRM FILE TRANSMISSION? 00867000
BNO GETFILE NO - GO DIRECTLY TO READ 00868000
NI RDEVFLAG,X'FF'-MSGON ISSUE ONLY ONE MESSAGE 00869000
L R1,RDEVTAG GET RDR TAG ADDRESS 00870000
MVC MSGVMID(8),TAGINVM SET USERID FOR MSG 00871000
MSG 147,(RDEVFID,AXSLINK) WRITE MSG 00872000
B GETOUT AND RETURN 00873000
SPACE 00874000
* OPEN SECTION 00875000
SPACE 00876000
GETFILE EQU * 00877000
TM RDEVFLAG,FILREADY IS A FILE READY? 00878000
BNO GETOUT NO 00879000
TM RDRCMD,RHLDIPGS WAS A HOLD REQUESTED? 00880000
BNO GETFILE1 NO CONTINUE 00881000
L R7,NPTALINK GET LINK TABLE ADDR 00882000
OI LFLAG,LHOLD INDICATE WE ARE HELD 00883000
MVC MSGLINK(8),HLDCMDLK MOVE IN RESPONSE LINKID 00884000
MSG 611,AXSLINK AND WRITE THE MSG 00885000
NI RDRCMD,255-RHLDIPGS RESET CMD BYTE 00886000
B GETOUT AND CONTINUE 00887000
SPACE 1 00888000
GETFILE1 EQU * 00889000
OI NPTFLAGS,MSGSEND SET SENDING FLAG 00890000
BAL R14,AXSGET GO OPEN THE FILE 00891000
B GETGOT OPEN FILE READY - CHECK IT 00892000
EJECT 00893000
* AXSGET RETURN HERE IN CASE OF FAILING IN OPEN 00894000
NI NPTFLAGS,X'FF'-MSGSEND RESET SEND FLAG - OPEN FAILED 00895000
GETOUT EQU * 00896000
LM R13,R15,GETSAVE RESTORE CALLER'S REGISTERS 00897000
B 4(R14) AND RETURN (NON-STANDARD RETURN) 00898000
SPACE 2 00899000
GETGOT EQU * 00900000
CLC RDEVSTYL(5),=C'PRINT' IS IT A PRINT FILE? 00901000
BNE GETGOT1 NO CONTINUE 00902000
OI GETFLAGS,PRNTSEND SET SENDING PRINT FILE 00903000
MVI PREVOP,X'00' CLEAR LAST SAVED CCW OP CODE @VA04171 00903200
MVI PREVOPS,X'00' @VA04171 00903400
GETGOT1 EQU * 00904000
OI NPTFLAGS,HEADFLAG SET SENDING HEADER 00905000
L R1,RDEVTAG GET THE TAG ADDRESS 00906000
L R14,TAGRECNM LOAD RECORD NUMBER INTO 14 00907000
LH R1,TAGID AND THE BINARY SPOOL FILE ID IN R1 00908000
CVD R1,AXSCVD CONVERT IT TO DECIMAL 00909000
UNPK RDEVFID,AXSCVD AND SPREAD THE DIGITS 00910000
OI RDEVFID+3,X'F0' MAKE SURE THE LAST IS PRINTABLE 00911000
CVD R14,AXSCVD CONVERT RECORDS TO DECIMAL 00912000
UNPK AXSRECS,AXSCVD SPREAD THE DIGITS 00913000
OI AXSRECS+7,X'F0' MAKE SURE THE LAST IS PRINTABLE 00914000
MVC HDRRECS(8),AXSRECS MOVE INTO HDR LINE 00915000
MVC HDRFILE(4),RDEVFID AND THE FILE ID 00916000
TM GETFLAGS,PRNTSEND IS IT A PRINT FILE? 00917000
BO GETGOT2 YES - GO AHEAD 00918000
TM DEVFEAT,REMPUNCH IS A PUNCH DEVICE THERE? 00919000
BO GETGOT2 YES - CONTINUE 00920000
L R1,RDEVTAG GET TAG ADDRESS @VA07770 00920500
MVC MSGVMID(8),TAGINVM MOVE USERID TO MSG 00921000
MSG 936,(AXSLINK,RDEVFID) WRITE THE MSG 00922000
B GETPURGE PURGE THE FILE 00923000
SPACE 00924000
EJECT 00925000
GETGOT2 EQU * 00926000
MSG 146,(RDEVFID,AXSLINK,AXSRECS) WRITE MSG 00927000
MVC MAXREC(2),MAXREC1 SET MAX REC 00928000
TM GETFLAGS,PRNTSEND SENDING PRINT? @VA03112 00929000
BNZ GETSETUP YES 00930000
TM DEVFEAT,TRANSP TRANSPARENCY ? @VA05795 00930100
BZ GETSETUP NO. @VA05795 00930200
MVI MAXREC+1,X'01' SET MAX REC 00931000
GETSETUP EQU * 00932000
OI GETFLAGS,BUFEMPTY INDICATE BUFFER EMPTY 00933000
LM R13,R15,GETSAVE RESTORE THE CALLER REGISTERS 00934000
BR R14 AND RETURN (STANDARD RETURN) 00935000
EJECT 00936000
DROP R1 00937000
GETBKFIL EQU * 00938000
USING SPLINK,R1 GET SPLINK ADDRESSABILITY 00939000
L R1,RDEVFIOA GET FILE I/O AREA ADDRESS 00940000
L R2,RDEVTAG GET READER TAG ADDRESS 00941000
LH R2,TAGDEV-TAG(R2) GET READER ADDRESS 00942000
LA R3,X'14' INDICATE BACKSPACE FILE 00943000
DIAG R1,R2,X'14' COMMAND SPOOL READER 00944000
GETBKFL1 EQU * 00945000
NI GETFLAGS,255-FILLED-EOF INDIC. EMPTY & NOT EOF @VA03749 00946000
NI NPTFLAGS,255-ETXSEND TURN OFF ETX JUST IN CASE @VA03749 00947000
GETBKFL2 EQU * 00948000
LA R8,GETEXEC1 INDICATE RETURN 00949000
GTBKMSG EQU * 00950000
MVC MSGLINK(8),RDRCMDLK MOVE IN RESPONSE LINKID 00951000
MSG 510,RDEVFID WRITE BACKSPAC MSG 00952000
NI RDRCMD,255-RBACKFIL-RBACKCNT RESET CMD BYTE 00953000
BR R8 AND CONTINUE 00954000
EJECT 00955000
GETBKUP EQU * 00956000
L R5,RDEVTAG GET READER TAG ADDRESS 00957000
L R1,RDEVFIOA GET FIOA ADDR 00958000
L R3,SPRECNUM AND NUMBER OF RECORDS 00959000
S R3,VMSPNUM SUBSTRACT WHATS LEFT 00960000
BZ GDBKPAGA ALL DONE WITH THIS PAGE 00961000
LA R4,SPRECNUM+4 GET DATA ADDR 00962000
ST R4,VMSPANCH STORE ANCHOR FOR UNPACK 00963000
ST R4,VMSPNEXT AND THE NEXT DATA STRING 00964000
ST R3,VMSPNUM STORE THE NEW COUNT 00965000
OI GETFLAGS,FILLED FILE ALREADY HERE @VA10237 00965100
NI GETFLAGS,255-EOF TURN OF EOF FLAG AND @VA03749 00966000
NI NPTFLAGS,255-ETXSEND ETX FLAG JUST IN CASE @VA03749 00967000
TM TAGINDEV-TAGNEXT(R5),TYPPUN IS IT A PUNCH FILE? 00968000
BNO GBACKCN2 NO..MUST BE PRINT 00969000
L R3,VMSPNUM GET THE CURRENT COUNT 00970000
B GBACKCN3 AND CONTINUE 00971000
SPACE 1 00972000
GBACKCN1 EQU * 00973000
LPR R3,R3 MAKE POSITIVE 00974000
ST R3,RDRCMDCT UPDATE NUMBER OF BACKS 00975000
GDBKPAGA EQU * 00976000
BAL R14,GDBKPAGE GO BACKPAGE 00977000
GBACKCN2 EQU * 00978000
TM TAGINDEV-TAGNEXT(R5),TYPPRT IS IT A PRINT FILE? 00979000
BO GCNTSKP YES..MUST SKIP PAGES NOT RECS 00980000
L R3,SPRECNUM GET THE NEW NUM OF RECORDS 00981000
GBACKCN3 EQU * 00982000
S R3,RDRCMDCT SUBSTRACT NEW NUM 00983000
LTR R3,R3 ARE WE DONE? 00984000
BNP GBACKCN1 NO CONTINUE 00985000
BAL R14,GDBKPCON RESET TO BEGINNING OF PAGE 00986000
GBACKSK EQU * 00987000
BAL R14,MAKEBLOC GET A RECORD 00988000
TM TAGINDEV-TAGNEXT(R5),TYPPUN IS IT A PUNCH FILE? 00989000
BO GBACKDWN YES COUNT ALL 00990000
CLI BUFUNPK,X'89' PRINT AND SKIP TO CHAN 1? 00991000
BE GBACKDWN YES COUNT IT 00992000
CLI BUFUNPK,X'8B' IMMED SKIP TO CHAN 1? 00993000
BNE GBACKSK NO TRY ANOTHER 00994000
GBACKDWN EQU * 00995000
BCT R3,GBACKSK DOWN BY ONE 00996000
LA R8,PACKBLK INDICATE RETURN 00997000
CLI BUFUNPK,X'8B' IS IT A SKIP IMMED? 00998000
BE GTBKMSG YES..CONTINUE @VM01138 00999000
MVI BUFUNPK,X'8B' BETTER MAKE IT 01000000
MVI BUFUNPK+1,C' ' AND ONE CHAR OF DATA 01001000
LA R1,2 COUNT OF TWO 01002000
STH R1,BUFCNT AND THIS AMOUNT OF DATA 01003000
OI GETFLAGS,IMCMD SHOW IMMED COMMAND 01004000
B GTBKMSG ALL DONE 01005000
EJECT 01006000
GCNTSKP EQU * 01007000
SR R3,R3 ZERO OUT ACCUMLATOR 01008000
GCNTSKP1 EQU * 01009000
BAL R14,MAKEBLOC GET A RECORD 01010000
CLI BUFUNPK,X'89' PRINT AND SKIP TO CHANNEL 1? 01011000
BE GCNTSKPC YES COUNT IT 01012000
CLI BUFUNPK,X'8B' IMMED SKIP TO CHANNEL 1? 01013000
BE GCNTSKPC YES COUNT IT 01014000
GCNTSKPX EQU * 01015000
ICM R0,B'1111',VMSPNUM ALL DONE WITH PAGE? 01016000
BNZ GCNTSKP1 NO CONTINUE 01017000
B GBACKCN3 BR BACK TO MAIN CODE 01018000
SPACE 1 01019000
GCNTSKPC EQU * 01020000
LA R3,1(,R3) UP SKIP COUNT BY 1 01021000
B GCNTSKPX AND JOIN COMMON CODE 01022000
SPACE 1 01023000
GDBKPAGE EQU * BACK UP A PAGE SUBROUTINE 01024000
STM R0,R15,MAKESAVE MIGHT AS WELL SAVE THEM ALL 01025000
LA R2,RDRBLK GET READER DEVICE BLK ADDR 01026000
L R1,RDEVFIOA GET FILE I/O AREA ADDRESS 01027000
L R2,RDEVTAG GET READER TAG ADDRESS 01028000
LH R2,TAGDEV-TAG(R2) GET READER ADDRESS 01029000
LA R3,X'18' INDICATE BACKSPACE PAGE 01030000
DIAG R1,R2,X'14' COMMAND SPOOL READER 01031000
BC 4,GDBKPAG2 ALL DONE BEGINNING OF FILE 01032000
GDBKPAG1 EQU * 01033000
L R8,SPRECNUM PICKUP SPRECNUM FROM NEW BLOCK 01034000
ST R8,VMSPNUM PICKUP COUNT OF REMAINING CCWS 01035000
LA R8,SPRECNUM+4 SETP OVER POINTERS IN SPOOL BLOCK 01036000
ST R8,VMSPANCH TO PICKUP CURRENT CCW ANCHOR 01037000
ST R8,VMSPNEXT CCW POINTER AND NEXT 01038000
OI GETFLAGS,FILLED TO INDICATE BLOCK PRESENT 01039000
LM R0,R15,MAKESAVE RESTORE REGS 01040000
BR R14 AND RETURN 01041000
SPACE 1 01042000
GDBKPAG2 EQU * 01043000
LA R14,GETBKFL2 INDICATE RETURN POINT 01044000
SPACE 1 01045000
GDBKPCON EQU * 01046000
STM R0,R15,MAKESAVE SAVE REGISTERS 01047000
B GDBKPAG1 AND SIMULATE A PAGE BACK 01048000
EJECT 01049000
GETGOFWD EQU * 01050000
L R1,RDRCMDCT GET FWD COUNT 01051000
LA R2,RDRBLK GET READER DEVICE BLK ADDR 01052000
L R8,RDEVTAG AND THE TAG ADDR 01053000
GGOFWDLP EQU * 01054000
NI GETFLAGS,255-IMCMD TURN OFF IMMED CMD FLAG 01055000
BAL R14,MAKEBLOC GO GET A RECORD 01056000
BNZ GDGODNE ALL DONE EOF 01057000
TM TAGINDEV-TAGNEXT(R8),TYPPUN IS IT A PUNCH FILE? 01058000
BO GGOCNT COUNT ALL RECORDS 01059000
CLI BUFUNPK,X'89' PRINT AND SKIP TO CHANNEL 1? 01060000
BE GGOCNT YES COUNT IT 01061000
CLI BUFUNPK,X'8B' IMMED SKIP TO CHANNEL 1? 01062000
BNE GGOFWDLP NO..CONTINUE 01063000
GGOCNT EQU * 01064000
BCT R1,GGOFWDLP REDUCE REC CNT BY 1 AND CONT 01065000
GDGODNE EQU * 01066000
MVC MSGLINK(8),RDRCMDLK MOVE IN RESPONSE LINKID 01067000
MSG 600,RDEVFID WRITE FWD SPAC MSG 01068000
NI RDRCMD,255-RFWDCNT RESET CMD BYTE 01069000
CLI BUFUNPK,X'8B' IS IT A SKIP IMMED? 01070000
BE PACKBLK YES..CONTINUE 01071000
MVI BUFUNPK,X'8B' BETTER MAKE IT 01072000
MVI BUFUNPK+1,C' ' AND ONE CHAR OF DATA 01073000
LA R1,2 COUNT OF TWO 01074000
STH R1,BUFCNT AND THIS AMOUNT OF DATA 01075000
OI GETFLAGS,IMCMD SHOW IMMED COMMAND 01076000
B PACKBLK AND CONTINUE 01077000
DROP R1 01078000
USING TAG,R1 GET TAG ADDRESSABILITY 01079000
EJECT 01080000
*---------------------------------------------------------------------* 01081000
* * 01082000
* BLOCK PACKING AND TRANSLATION SECTION * 01083000
* * 01084000
*---------------------------------------------------------------------* 01085000
SPACE 01086000
PACKBLK EQU * 01087000
MVC PREVOPS(1),BUFUNPK SAVE CURRENT FOR LATER USE @VA03488 01088000
LH R5,BUFCNT IN REG.5 BYTES COUNT 01089000
TM GETFLAGS,IMCMD IMMEDIATE CARRIAGE COMMAND? 01090000
BNO PACKBLKB NO @VA03488 01091000
NI GETFLAGS,X'FF'-IMCMD RESET IT 01092000
TM DEVFEAT,REM2780 IS IT A 2780 01093000
BNO NOPACK NO..CONTINUE 01094000
TM NPTFLAGS,HEADFLAG SENDING A HEADER? 01095000
BO NOPACK YES..SKIP CHECK 01096000
CLI PREVOP,X'01' WAS PREVIOUS CCW CC A @VA03488 01097000
* WRITE NO SPACE 01098000
BNE NOPACK NO - NO SPECIAL HANDLING @VA03488 01099000
TM BUFUNPK,X'80' IS THIS A SKIP OR SPACE @VA03488 01100000
BO NOPACK SKIP - NO SPECIAL HANDLING @VA03488 01101000
CLI BUFUNPK,X'0B' IS IT A SPACE ONE IMMEDIATE @VA03488 01102000
BNE PACKBLK1 BRANCH IF NOT @VA04946 01102400
MVC PREVOP(1),PREVOPS REMOVE WRITE NO SPACE @VA04946 01102800
B GETEXEC2 AND GET NEXT CCW @VA04946 01103200
PACKBLK1 EQU * @VA04946 01103600
CLI BUFUNPK,X'13' IS IT A SPACE TWO IMMEDIATE @VA03488 01104000
BNE PACKBLKA NO - CONTINUE CHECK @VA03488 01105000
MVI BUFUNPK,X'0B' ACCOUNT FOR PREV WRITE NO SPACE @VA03488 01106000
B NOPACK @VA03488 01107000
PACKBLKA CLI BUFUNPK,X'1B' IS IT A SPACE THREE IMMEDIATE @VA03488 01108000
BNE NOPACK NO - DO NOT KNOW WHAT IT IS @VA03488 01109000
MVI BUFUNPK,X'13' ACCOUNT FOR PREV WRITE NO SPACE @VA03488 01110000
B NOPACK @VA03488 01111000
PACKBLKB TM DEVFEAT,REM2780 IS IT A 2780 @VA03488 01112000
BNO PRINT0 NO - NO SPECIAL PROCESSING @VA03488 01113000
CLI PREVOP,X'01' WAS PREVIOUS CCW CC A @VA03488 01114000
* WRITE NO SPACE 01115000
BNE PRINT0 NO - NO SPECIAL PROCESSING @VA03488 01116000
CLI BUFUNPK,X'09' IS IT A WRITE SPACE ONE @VA03488 01117000
BNE PACKBLKD NO - KEEP CHECKING @VA03488 01118000
MVI PREVOPS,X'01' MAKE IT REMEMBER THE WRITE @VA03488 01119000
* NO SPACE UNTIL ACCOUNTED FOR 01120000
* OR A SKIP CCW OP CODE IS FOUND 01121000
B PRINT0 @VA03488 01122000
PACKBLKD CLI BUFUNPK,X'11' IS IT A WRITE SPACE TWO @VA03488 01123000
BNE PACKBLKC NO - CONTINUE CHECK @VA03488 01124000
MVI BUFUNPK,X'09' ACCOUNT FOR PREV WRITE NO SPACE @VA03488 01125000
B PRINT0 @VA03488 01126000
PACKBLKC CLI BUFUNPK,X'19' IS IT A WRITE SPACE THREE @VA03488 01127000
BNE PRINT0 DO NOT KNOW WHAT IT IS @VA03488 01128000
MVI BUFUNPK,X'11' ACCOUNT FOR PREV WRITE NO SPACE @VA03488 01129000
SPACE 01130000
PRINT0 EQU * 01131000
LA R4,BUFUNPK GET BUFFER ADDRESS 01132000
LR R2,R5 IN REG.2 BYTES COUNT 01133000
LA R5,0(R2,R4) LAST CHARACTER ADDRESS 01134000
TM GETFLAGS,PRNTSEND SENDING PRINT? @VA03112 01135000
BZ NOPRINT NOTHING TO DO 01136000
* OTHERWISE PACK THE TRAILING BLANKS 01137000
SRL 2,1 MULT BY 2 01138000
BLKLOOP EQU * 01139000
SH R5,=H'2' DOWN BY 2 01140000
CLC 0(2,R5),BLANK 2 FILLED BLANKS? 01141000
BNE BLKEND NOPE 01142000
BCT R2,BLKLOOP YES CONTINUE THE SCAN 01143000
BLKEND EQU * 01144000
LA R5,2(R5) UP BY 2 01145000
NOPRINT EQU * 01146000
SR R5,R4 BYTES IN THE PACKED RECORD 01147000
CH R5,MAXPRINT EXCEED MAX.PRINTABLE POSITIONS? 01148000
BNH NOPACK NOPE 01149000
LH R5,MAXPRINT FORCE MAX.PRINTER RECORD LENGTH 01150000
NOPACK EQU * 01151000
MVC PREVOP(1),PREVOPS SAVE CURRENT FOR NEXT PASS @VA03488 01152000
STH R5,BUFCNT STORG RECORD'S BYTE COUNT 01153000
LA R2,BUFUNPK GET BUFFER ADDR 01154000
* TRANSLATE CONTROL CARRIEGE CHARACTER 01155000
TM GETFLAGS,PRNTSEND PRINT FILE? 01156000
BO CC1 YES - GO TO TRANSLATE 01157000
LA R2,1(R2) NO - IGNORE THE CCW CODE 01158000
BCTR R5,0 UPDATE BYTES COUNT @VA03862 01158500
TM DEVFEAT,TRANSP TRANSPARENCY AVAILABLE? @VM01140 01159000
BNO NOPACK1 NO..ERROR @VM01140 01160000
LA R5,80 MUST TRANSMIT ALL 80 CHARS @VA03862 01161000
NOPACK1 EQU * @VM01140 01163000
STH R5,BUFCNT AND STORE IT 01164000
B CCOK2 AND GO TO SAVE THE POINTER 01165000
SPACE 01166000
TRPR TR 1(0,R2),TRPRTB TO BE EXECUTED FROM ABOVE 01167000
EJECT 01168000
CC1 EQU * 01169000
SR R15,R15 CLEAR FOR IC 01170000
IC R15,BUFUNPK PUT C.C. 01171000
SRL R15,3 CLEAR OUT 01172000
TM DEVFEAT,REM2780 IS IT THE 2780 @VA03488 01173000
BO CC2780 YES - SET UP FOR THE 2780 @VA03488 01174000
IC R15,CCTAB(R15) TRANSLATED CONTROL CARR. CHAR. 01175000
B STCC @VA03488 01176000
CC2780 IC R15,CCT2780(R15) USE THE 2780 TRANSLATE TABLE @VA03488 01177000
STCC EQU * @VA03488 01178000
STC R15,BUFUNPK STORE IT 01179000
CCOK2 EQU * 01180000
ST R2,BUFSTART STORE START POINTER 01181000
NI GETFLAGS,X'FF'-BUFEMPTY SIGNAL BUFFER FULL 01182000
TM GETFLAGS,PRNTSEND PRINTER FILE? @VA03112 01183000
BZ GETLINE NO - NO TRANSLATION 01184000
BCTR R5,0 -1 FOR EXEC 01185000
LTR R5,R5 ZERO BYTES COUNT? 01186000
BNP GETLINE YES - NO TRANSL. 01187000
EX R5,TRPR TRAN PRT LNE TO AVOID INV CHAR 01188000
TM DEVFEAT,BLKCOMP COMPRESSION FEATURE PRESENT? @VA03112 01189000
BNO GETLINE SKIP COMPRESSION. @VA03112 01190000
L R1,BUFSTART ADDRESS INTO R1 @VA03112 01191000
LH R0,BUFCNT COUNT INTO R0 @VA03112 01192000
BAL R14,CMPR GO COMPRESS IT. @VA03112 01193000
ST R1,BUFSTART RESTORE POINTER. @VA03112 01194000
STH R0,BUFCNT STORE NEW COUNT. @VA03112 01195000
SPACE 01196000
* LINE BUFFER PREPARE SECTION 01197000
SPACE 01198000
GETLINE EQU * 01199000
LH R5,BUFCNT SET BYTES COUNT 01200000
L R2,BUFSTART AND START POINTER 01201000
LA R5,1(R5) ADVANCE BYTES COUNT FOR ESC 01202000
TM DEVFEAT,REM2770 IS IT A 2770 ? @VA05668 01202100
BNO GETLINE1 NO @VA05668 01202200
LA R5,1(R5) UP BYTE COUNT FOR POSSIBLE ETB @VA05668 01202300
GETLINE1 EQU * 01203000
AH R5,BYTSCNT ADD ACTUAL LINE BUFFER BY.S COUNT 01204000
CH R5,MAXBYTS EXCEED MAX. TRASMITTIBLE BYTES ? 01205000
BNL RETURN YES - RETURN 01206000
TM DEVFEAT,REM2770 IS IT A 2770 ? @VA05668 01206100
BNO N2780 NO @VA05668 01206200
BCTR R5,0 RESET BYTE COUNT FOR 2770 @VA05668 01206300
N2780 EQU * @VA05668 01206400
BCTR R5,0 RESET BYTES COUNT @VM01141 01207000
LH R8,RECNT LOAD LINE RECORDS COUNT 01208000
LA R8,1(R8) UP BY 1 01209000
CH R8,MAXREC EXCEED MAX.TRASMITTIBLE RECORDS? 01210000
BH RETURN YES 01211000
L R6,STARTLIN GET THE START ADDR 01212000
TM GETFLAGS,PRNTSEND SENDING PRINT? 01213000
BNO GETPUN1 NO 01214000
MVI 0(R6),ESC INSERT ESC CHARACTER 01215000
LA R5,1(R5) UPDATE BYTES COUNT FOR ESC @VM01141 01216000
LA R6,1(R6) UPDATE LINE BUFFER POINTER 01217000
GETPUN1 EQU * 01218000
LH R7,BUFCNT GET THE BUFFER COUNT 01219000
BCTR R7,0 DOWN BY 1 FOR EX 01220000
L R2,BUFSTART GET THE START OF BUFFER 01221000
EX R7,MVCLIN MOVE RECORD IN LINE BUFFER 01222000
OI GETFLAGS,BUFEMPTY SET ON THE BUFFER EMPTY FLAG 01223000
AR R6,R7 ADD IN NEW COUNT 01224000
LA R6,1(R6) UP BY 1 01225000
TM GETFLAGS,PRNTSEND SENDING PRINT? @VA03640 01226000
BZ NOEJECT NO @VA03640 01227000
TM GETFLAGS,EJECT HAVE WE REC'D EOF? @VA03640 01228000
BZ NOEJECT NO @VA03640 01229000
OI NPTFLAGS,ETXSEND YES, INDIC. SEND ETX @VA03640 01230000
NOEJECT EQU * @VA03640 01231000
TM GETFLAGS,PRNTSEND PRINTER READER ? 01232000
BO GETPRINT YES 01233000
TM DEVFEAT,TRANSP NO - TRANSP.FEATURE ? 01234000
BO RETLIN YES 01235000
GETPRINT EQU * 01236000
MVI 0(R6),ITB MOVE IN CONTROL CHAR 01237000
TM DEVFEAT,REM2780 IS IT A 2780? 01238000
BO N27703 YES 01239000
MVI 0(R6),IRS MOVE IN CONTROL CHAR 01240000
N27703 EQU * 01241000
LA R5,1(R5) UPDATE BYTES COUNT 01242000
LA R6,1(R6) AND STARTING POINTER 01243000
RETLIN EQU * 01244000
ST R6,STARTLIN SET LINE BUFFER POINTER 01245000
STH R5,BYTSCNT BYTES COUNT 01246000
STH R8,RECNT RECORDS COUNT 01247000
XC BUFCNT(2),BUFCNT RESET COUNT OF INTERMEDIATE BUFFER 01248000
B GETNEW GO TO GET A NEW RECORD 01249000
SPACE 01250000
GETEOF EQU * 01251000
OI GETFLAGS,EOF SET ON THE EOF FLAG @VA03640 01252000
RETURN EQU * 01253000
OI CTFLG,ADFLG TURN ON ADD ONE FOR END CHAR @VA07005 01253500
TM GETFLAGS,PRNTSEND SENDING PRINT? 01254000
BO RET YES 01255000
TM DEVFEAT,TRANSP TRANSP. FEATURE ? 01256000
BZ RET @VA05796 01257000
NI CTFLG,X'FE' TURN OFF ADD ONE FOR END CHAR @VA07005 01257500
TM GETFLAGS,EOF EOF FLAG ON? @VA03640 01258000
BZ RET1 NO 01259000
MVI ETBTRA+1,ETX MOVE IN CONTROL CHAR 01260000
B RET1 AND CONTINUE 01261000
RET EQU * 01262000
TM DEVFEAT,REM2770 IS IT A 2770 01263000
BO S27703 YES 01264000
S2770A EQU * @VA03862 01264500
BCTR R6,0 DOWN BY 1 01265000
NI CTFLG,X'FE' TURN OFF ADD ONE FOR END CHAR @VA07005 01265500
S27703 EQU * 01266000
TM GETFLAGS,EOF SENDING EOT? @VA03640 01267000
BZ RET0 NO 01268000
MVI 0(R6),ETX MOVE IN ETX 01269000
B RET1 AND CONTINUE 01270000
SPACE 1 01271000
RET0 EQU * 01272000
MVI 0(R6),ETB CHANGE ITB CHARACTER TO ETB 01273000
RET1 EQU * 01274000
LH R15,BYTSCNT GET COUNT 01275000
TM CTFLG,ADFLG IS THE ADD BIT ON @VA07005 01275410
BZ N27705 NO, COUNT OK AS IS @VA03862 01275800
LA R15,1(R15) UP BY ONE 01278000
N27705 EQU * 01279000
STH R15,TRANSMIT+6 STORE COUNT IN CCW @VA03349 01280000
LM R13,R15,GETSAVE RESTORE REGS 01281000
BR R14 AND GO BACK TO CALLER (STAN RET) 01282000
DROP R1 DROP TAG ADDRESSABILTIY 01283000
* 01284000
MVCLIN MVC 0(0,R6),0(R2) MOVE INSTRUCTION 01285000
SPACE 1 01286000
RDEVFID DC CL4' ' EBCDIC SPOOL FILE ID 01287000
DC CL4' ' MSG FILLER 01288000
CTFLG DC X'00' FLAG FIELD @VA07005 01288300
ADFLG EQU X'01' FLAG BIT FOR ADD ENDING CHAR @VA07005 01288600
EJECT 01289000
*. 01290000
* 01291000
* ENTRY NAME - 01292000
* 01293000
* SENDVRFY 01294000
* 01295000
* FUNCTION - 01296000
* 01297000
* THIS ROUTINE ANALYZES THE RESPONSE OBTAINED FROM EACH 01298000
* BUFFER TRANSMITTED AND TAKES THE APPROPRIATE ERROR 01299000
* ACTION 01300000
* 01301000
* CALLS TO OTHER ROUTINES - 01302000
* 01303000
* NONE 01304000
* 01305000
* OPERATION - 01306000
* 01307000
* 1. CHECK REPLY FOR I/O ERROR, IF PRESENT RETRY OPERATION 01308000
* IF NECESSARY. 01309000
* 01310000
* 2. CHECK FOR CORRECT REPLY IN RESPONSE BUFFER, IF PRESENT EXIT 01311000
* 01312000
* 4. IF ENQ RECEIVED, INDICATE REQUEST TO TRANSMIT A FILE FROM 01313000
* THE REMOTE STATION. 01314000
* 01315000
* 5. IF INCORRECT REPLY RECEIVED, TAKE CORRECTIVE ACTION. 01316000
* 01317000
* ON ENTRY: 01318000
* 01319000
* REG. 8 RETURN ADDRESS 01320000
* REG. 14 AND 15 USED AND NOT SAVED 01321000
* 01322000
* RESPONSES - 01323000
* 01324000
* NONE 01325000
* 01326000
* ERROR MESSAGES - 01327000
* 01328000
* NONE 01329000
* 01330000
*. 01331000
SPACE 3 01332000
SENDVRFY DC 0H'0' @VA03349 01333000
LA R14,RETRYNUM SET THE RETRY NUM 01334000
ST R14,TMTCNTR IN THE TIMEOUT CONTROL 01335000
TM DEVFLAGS,IOERR ANY ERROR? 01336000
BO CKERR YES - GO CHECK IT OUT @VA03349 01337000
SENDVRFA CLC RESP(2),EXPRESP IS RESPONSE CORRECT @VA03349 01338000
BE OK YES - GO AHEAD 01339000
CLI RESP,NAK WAS A NAK RECEIVED @VA03349 01340000
BNE NONAK NO - CONTINUE 01341000
TM SELFLAGS,PCHSEL SELECTING THE PUNCH @VA03349 01342000
BNO CKCTL GO CHECK FOR CNTL MODE @VA03349 01343000
LA R0,5 SET UP FOR 5 SEC DELAY @VA03349 01344000
BAL R14,TDELAY TAKE FIVE @VA03349 01345000
B REL1A IGNORE PRT NOT READY @VA03349 01346000
CKCTL TM LINERROR,CTLMODE DEVICE PUT US IN CTL MODE @VA03349 01347000
BO PUTENQA YES - ENQ AND NOT DATA REXMIT @VA03349 01348000
OI LINERROR,NAKREC INDICATE A NAK RECEIVED @VA03349 01349000
LH R14,NAKCOUNT GET CONTINOUS NAK COUNT @VA03349 01350000
LA R14,1(0,R14) BUMP @VA03349 01351000
STH R14,NAKCOUNT SAVE IT @VA03349 01352000
CH R14,RETRYNAK RETRIED ENOUGH YET @VA03349 01353000
BL NPTTALK NO - RETRY TRANSMISSION @VA03349 01354000
SR R14,R14 @VA03349 01355000
STH R14,NAKCOUNT RESET THE ERROR COUNT @VA03349 01356000
OI LINERROR,NAKEOT SET SECOND PASS INDICATOR @VA03349 01357000
BAL R14,SENDEOT RESET THE DEVICE AND RETRY @VA03349 01358000
PUTENQA LA R0,15 SET UP FOR 15 SEC DELAY @VA03349 01359000
BAL R14,TDELAY TAKE FIVE @VA03349 01360000
B PUTENQ GO RETRY THE TRANSMISSION @VA03349 01361000
SPACE 1 01362000
CKERR TM SELFLAGS,PCHSEL SELECTING THE PUNCH @VA03349 01363000
BO RESLINE YES, RESET AND TRY AGAIN @VA03349 01364000
L R15,DEVCSW GET ADDR OF LAST CCW + 8 @VA03349 01365000
LA R15,0(0,R15) @VA03349 01366000
S R15,=F'8' BACK UP TO FAIL CCW @VA03349 01367000
CLI 0(R15),X'02' READ RESP FAILED @VA03349 01368000
BNE NPTTALK NO - DEVICE DID NOT GET IT @VA03349 01369000
* TRY RETRANSMISSION OF BUFFER 01370000
OI LINERROR,CKRESP INDICATE REQUEST FOR LAST ACK @VA03349 01371000
B PUTENQ GO ASK DEVICE @VA03349 01372000
SPACE 01373000
RESLINE EQU * 01374000
BAL R14,SENDEOT GO TO SEND EOT 01375000
NI LINERROR,X'FF'-NAKREC RESET THE NAK FLAG 01376000
LA R15,REPLYCNT GET RETRY COUNT 01377000
B PUTENQ AND TRY TO RESTART THE TRANSMISSION 01378000
EJECT 01379000
NONAK EQU * 01380000
XC NAKCOUNT(2),NAKCOUNT CLEAR THE NAK COUNTER @VA03349 01381000
CLI RESP,ENQ IS HE TRYING TO SEND? @VA03349 01382000
BE GETENQ START HIM UP 01383000
CLI RESP,EOT IS IT END OF TRANSMISSION @VA03349 01384000
BE EOTREC1 YES - OUTPUT DEVICE NOT READY 01385000
CLC RESP(2),WACK IS IT A DELAY @VA03349 01386000
BNE CKRVI YES - WHAT TO DO NOT @VA03349 01387000
OI LINERROR,WACKREC INDICATE A WACK RECEIVED @VA03349 01388000
LA R0,1 SET UP FOR 1 SEC DELAY @VA03349 01389000
BAL R14,TDELAY TAKE ONE @VA03349 01390000
B PUTENQ LOOP TILL HE IS READY @VA03349 01391000
CKRVI EQU * @VA04945 01392300
CLC RESP(2),=AL1(DLE,RVI) DOES HE WANT THE LINE? @VA04945 01392700
BE NSWITCH WHAT TO DO NOW @VA03349 01393000
TM LINERROR,CKRESP REREAD OF LAST RESP @VA03349 01394000
BZ CKPSEL NO - WHAT TO DO NOW @VA03349 01395000
CLC RESP(2),EXPRESP DID THE DEVICE GET LAST XMISSION@VA03349 01397000
BNE NPTTALK NO, RETRANSMIT @VA04945 01397700
B OK YES, DO NEXT TRANSMISSION @VA04945 01398300
NSWITCH BAL R14,SENDEOT NO - END OUR TRANSMISSION @VA03349 01399000
B NPTACK0 GOP LET HIM TALK @VA03349 01400000
CKPSEL TM SELFLAGS,PCHSEL SELECTING THE PUNCH @VA03349 01401000
BNO NSWITCH YES, OPPOSITE IS OK HERE @VA03349 01402000
XI EXPRESP+1,X'11' SWITCH THE EXPECTED RESPONSE @VA03349 01403000
CLC RESP(2),EXPRESP IS IT THE OTHER ACK @VA03349 01404000
BNE NSWITCH NO, DON'T KNOW WHAT IT IS @VA03349 01405000
XI EXPRESP+1,X'11' RESTORE THE EXPECTED RESPONSE @VA03349 01406000
B OK1 OTHER RESP CAN HAPPEN WHEN @VA03349 01407000
* SELECTING AND SWITCH FROM 01408000
* TRASNMIT TO RECEIVE NON-TRANSP 01409000
SPACE 2 01410000
OK EQU * 01411000
XC NAKCOUNT(2),NAKCOUNT CLEAR THE NAK COUNTER @VA03349 01412000
XI EXPRESP+1,X'11' SWITCH THE EXPECTED RESP @VA03349 01413000
CLC DEVSTART,=A(SELPROG) IS IT THE SELECT PROGRAM @VA03349 01414000
BE OKPCHS YES @VA03349 01415000
TM SELFLAGS,PCHSEL SELECTING THE PUNCH @VA03349 01416000
BO REL1A YES, TRY IT AGAIN @VA03349 01417000
OKPCHS EQU * CHECK OF WACKS RCVD @VA08288 01418000
TM LINERROR,WACKREC RCVD A WACK? @VA08288 01418040
BNO LNERRCK NO, CHECK OTHER ERRORS @VA08288 01418080
MVI LINERROR,X'00' RESET ERROR INDICATORS @VA08288 01418120
***************************************************************@VA08288 01418160
* A WACK IS CONSIDERED POSITIVE RESPONSE TO A BUFFER AND IF IT @VA08288 01418200
* IS EVER RECEIVED, THEN THAT BUFFER WILL NOT BE RESENT. IF A @VA08288 01418240
* WACK (106B) IS RECEIVED, ALL OTHER LINE ERRORS ARE RESET, @VA08288 01418280
* THEIR PROIR RECEIPT TO ANY PREVIOUS BUFFER IS NOW INVALID @VA08288 01418320
* INFORMATION FOR THIS CURRENT BUFFER SEQUENCE... @VA08288 01418360
* A POSITIVE RESPONSE NEGATES ANY ERRORS BEFORE FOR THIS @VA08288 01418400
* BUFFER SINCE IT IS NOW ACCEPTED..... @VA08288 01418440
***************************************************************@VA08288 01418480
B OK1 DONT RESEND BUFFER AGAIN@VA08288 01418520
LNERRCK EQU * CHECK OTHER ERRORS @VA08288 01418560
TM LINERROR,NAKEOT+CTLMODE CORRECT RESPONSE AFTER @VA08288 01418600
* SENT OR RECEIVED EOT 01419000
* BECAUSE OF NAK RESPONSES 01420000
* OR NOT READY CONDITION 01421000
MVI LINERROR,X'00' IN ANY CASE RESET LINE ERRORS @VA03349 01422000
BNZ NPTTALK YES-GO RETRANSMIT THE SAME BUFFER@VA03349 01423000
OK1 EQU * @VA03341 01424000
BAL R14,TRTRAN COUNT TRANSACTION 01425000
BR R8 RET TO THE ADDR SPECIFIED ON ENTRY 01426000
SPACE 01427000
EOTREC1 EQU * 01428000
NI LINERROR,WACKREC RESET ALL BUT WACK FLG @VA08288 01429100
MVC RESP(2),INITACK0 EOT STARTS SEQ ALL OVER @VA03349 01430000
MVC EXPRESP(2),INITACK0 @VA03349 01431000
TM SELFLAGS,PCHSEL SELECTING THE PUNCH @VA03349 01432000
BO NOCTLM YES, SKIP CTL MODE SWITCH @VA03349 01433000
OI LINERROR,CTLMODE INDICATE NOT READY @VA03349 01434000
OI SELFLAGS,RSELECT FORCE RESELECTION @VA08171 01434500
NOCTLM EQU * @VA03349 01435000
TM DEVFEAT,REM2780 2780? @VA03342 01436000
BO PUTENQ YES @VA03342 01437000
LA R14,5 GET TIMEOUT COUNT FOR EOT @VA03342 01438000
ST R14,EOTCNT @VA03342 01439000
EOTREC2 MVC DEVSTART,=A(READINIT) LISTEN FOR ENQ @VA03349 01440000
BAL R14,LINEIO START I/O @VA03342 01441000
TM DEVFLAGS,IOERR END IN ERROR? @VA03342 01442000
BO TIMETEST YES @VA03342 01443000
CLI INIT,ENQ IS HE TRYING TO SEND @VA03349 01444000
BE GETENQ YES, GO ACCEPT INPUT @VA03342 01445000
TIMETEST TM DEVSENSE,TIMEOUT TIMEOUT? @VA03342 01446000
BZ EOTREC2 NO, GO READ AGAIN @VA03342 01447000
* 01447100
* TAKE A DELAY TO PREVENT CONTINUOUS POLLING 01447200
* 01447300
LA R0,10 TEN SECOND DELAY @VA04358 01447400
BAL R14,TDELAY TAKE TEN @VA04358 01447500
* 01447600
L R14,EOTCNT YES, GET COUNTER @VA03342 01448000
BCTR R14,0 @VA03342 01449000
ST R14,EOTCNT DECREMENT EOT COUNTER @VA03342 01450000
LTR R14,R14 ZERO YET? @VA03342 01451000
BNZ EOTREC2 NO, GO READ AGAIN @VA03342 01452000
* YES, FALL THRU TO PUTENQ 01453000
SPACE 2 01454000
PUTENQ EQU * 01455000
MVC DEVSTART(4),=A(ENQPROG) SET ENQ PROGRAM 01456000
BAL R14,LINEIO START THE LINE I/O 01457000
TM DEVFLAGS,IOERR END IN ERROR? 01458000
BNO REPENQ NO CONTINUE 01459000
TM SELFLAGS,PCHSEL ARE WE SELECTING THE PUNCH @VA03349 01460000
BO PCHEOT YES @VA03349 01461000
TM DEVSENSE,TIMEOUT TIMEOUT? 01462000
BNO PUTENQ NO 01463000
L R14,TMTCNTR GET TIMEOUT COUNTER 01464000
BCTR R14,0 DOWN BY ONE 01465000
ST R14,TMTCNTR SAVE TIMEOUT COUNTER 01466000
LTR R14,R14 ZERO YET? 01467000
BP PUTENQ NO CONTINUE 01468000
PCHEOT EQU * @VA03349 01469000
BAL R14,SENDEOT TRY TO RESET THE LINE 01470000
LA R14,RETRYNUM RESET THE TIMEOUT COUNTER 01473000
ST R14,TMTCNTR SAVE COUNTER 01474000
B PUTENQ AND TRY AGAIN 01475000
EJECT 01476000
REPENQ EQU * 01477000
TM SELFLAGS,PCHSEL SELECTING THE PUNCH @VA03349 01478000
BO SENDVRFY YES, CHECK RESULTS @VA03349 01479000
CLI LINEINB,ENQ CONTENTION? 01480000
BE GETENQ YES ACCEPT IT 01481000
TM LINERROR,WACKREC+NAKREC+CTLMODE+CKRESP @VA03349 01482000
* IS IT A WACK, NAK, NOT READY, 01483000
* OR RESPONSE REREAD 01484000
BNZ SENDVRFA YES - GO CHECK AGAIN FROM TOP @VA03349 01485000
TM INTFLAG,INTOUT OUTPUT INTERRUPTED FOR CMD @VA03349 01486000
BNO REPENQA NO, CONTINUE NORMALLY @VA03349 01487000
NI INTFLAG,X'FF'-INTOUT CLEAR THE INT FLAG @VA03349 01488000
OI SELFLAGS,RSELECT FORCE RESELECTION @VA03349 01489000
OI LINERROR,CTLMODE REESTABLISH THE LOGIC @VA03349 01490000
B SENDVRFY GO CHECK THE RESPONSE @VA03349 01491000
REPENQA BCT R15,PUTENQ DOWN BY ONE AND TRY AGAIN @VA03349 01492000
B RESLINE ALL DONE..SEND EOT 01493000
SPACE 01494000
GETENQ EQU * 01495000
OI INTFLAG,INTOUT SET INT REQ 01496000
B NPTACK0 YES - ACCEPT INPUT 01497000
SPACE 1 01498000
SPACE 01499000
RESERR EQU * 01500000
NI LINERROR,X'FF'-NOEXACK RESET FLAG 01501000
B PUTENQ AND CONTINUE 01502000
SPACE 01503000
EJECT 01504000
*. 01505000
* 01506000
* ENTRY NAME - 01507000
* 01508000
* PUTBLOCK 01509000
* 01510000
* FUNCTION - 01511000
* 01512000
* THIS ROUTINE DEBLOCKS RECEIVED TP BUFFERS AND WRITES THE 01513000
* DEBLOCKED RECORD TO THE VM/370 SPOOL FILE SYSTEM. 01514000
* 01515000
* CALLS TO OTHER ROUTINES - 01516000
* 01517000
* DMTAXS - TO OPEN AND CLOSE OUTPUT DEVICES 01518000
* 01519000
* OPERATION - 01520000
* 01521000
* 1. CHECK STATUS OF FILE PROCESSING. 01522000
* 01523000
* 2. UNPACK THE RECEIVED BUFFER INTO UNPACKED UNIT RECORD OUTPUT 01524000
* BUFFER. 01525000
* 01526000
* 3. DETERMINE IF THE CURRENT RECORD IS A COMMAND, IF YES, BAL 01527000
* TO COMMANDS. 01528000
* 01529000
* 4. VALIDATE THE USERID OF AN IDCARD. 01530000
* 01531000
* 5. OPEN A OUTPUT SPOOL FILE VIA A REQUEST TO DMTAXS. 01532000
* 01533000
* 6. WRITE THE RECORD TO THE VM/370 SPOOL FILE SYSTEM. 01534000
* 01535000
* 7. CLOSE THE OUTPUT ON AND EOT RECEIVED VIA CALL TO DMTAXS. 01536000
* 01537000
* RESPONSES - 01538000
* 01539000
* DMTNPT144I RECEIVING: FILE FROM 'LOCID1' ('USERID1') FOR 01540000
* 'LOCID2' ('USERID2') 01541000
* DMTNPT145I RECEIVED: FILE FROM 'LOCID1' ('USERID1') FOR 01542000
* 'LOCID2' ('USERID2') 01543000
* 01544000
* 01545000
* ERROR MESSAGES - 01546000
* 01547000
* DMTNPT934I ID CARD MISSING ON LINK 'LINKID' -- 01548000
* INPUT FILE PURGED 01549000
* 01550000
*. 01551000
EJECT 01552000
PUTBLOCK EQU * 01553000
USING TAG,R4 GET TAG ADDRESSABILITY 01554000
BAL R14,TRTRAN COUNT TRANSACTION 01555000
LA R2,PUNBLK POINTER TO THE PUNCH DEVICE 01556000
L R13,RDEVFIOA POINTER TO THE OUTPUT DEVICE 01557000
TM NPTFLAGS,MSGREC RECEIVING A FILE? 01558000
BO NOMSG YES - SKIP NEXT CODE 01559000
TM PUTFLAGS,EOTREC EOT RECEIVED? 01560000
BO PUTCLS4 YES - CHECK IF COMMAND 01561000
OI NPTFLAGS,MSGREC SET RECEIVING FLAG 01562000
NOMSG EQU * 01563000
XI RESP+1,X'11' SWITCH THE RESP @VA03349 01564000
TM PUTFLAGS,EOTREC EOT RECEIVED? 01565000
BO PUTCLOSE YES - CLOSE THE FILE 01566000
TM INTFLAG,WSM MORE DATA IN BUFFERS @VA03349 01567000
BNO SETLB NO @VA03349 01568000
NI INTFLAG,X'FF'-WSM CLEAR THE SPECIAL SIGNON FLAG @VA03349 01569000
B TRT1 YES USE BUFFER POINTER AS SET @VA03349 01570000
SETLB EQU * @VA03349 01571000
LA R7,LINEINB+1 SET POINTER TO THE FIRST 01572000
TM PUTFLAGS,TRANSP CHARACTER RECEIVED 01573000
BNO TRT1 NO 01574000
LA R7,1(R7) UP BY ONE 01575000
TRT1 EQU * 01577000
LR R6,R7 RESET LENGTH 01578000
TM PUTFLAGS,TRANSP TRANSPARENCY? 01584000
BNO TRT2 NO 01585000
TRT1A EQU * 01586000
LA R8,80 LOAD IN 80 01587000
LA R7,80(R7) UP BY 80 01588000
LR R2,R7 SET NEW COUNT 01589000
MVI TRTFNCBT,0 RESET TRT FUNCTION BYTE @VA05956 01589500
B FOUND AND CONTINUE 01590000
SPACE 1 01591000
TRT2 EQU * 01592000
SLR R1,R1 CLEAR FOR TRT ADDRESS @VA03643 01593000
TRT 0(256,R7),TAB TRANSLATE 01596000
BC 9,NPTNAK1 NO ONE - SEND NAK @VA05664 01604100
LR R7,R1 LOAD IN START OF LINE 01605000
STC R2,TRTFNCBT STORE TRT FUNCTION BYTE @VA04942 01605500
LR R2,R1 AND HERE TOO 01606000
SR R1,R6 RESET LENGTH 01607000
LR R8,R1 AND LOAD INTO R8 01608000
EJECT 01609000
FOUND EQU * 01610000
CLC 0(9,R6),SIGNOFF SIGNOFF CARD? @VA08251 01610100
BE LINEDIS2 YES,DRAIN LINK @VA08251 01610200
TM PUTFLAGS,XFERFLG ALREADY XFERED ? 01611000
BO PUTWRITE GO TO WRITE THE RECORD 01612000
LR R1,R6 GET LINE ADDR 01613000
CLC 0(9,R6),=C'ID ' ID CARD 01614000
BE FOUND1 YES -- PROCESS IT 01615000
CLC 0(3,R6),=X'C9C41D' ID CARD W/ SPACE COMPRESSION @VA03112 01616000
BNE CMDCK CHECK FOR COMMANDS @VA03112 01617000
OI PUTFLAGS,SPACMP INDICATE SPACE COMPRESSION @VA03112 01618000
B FOUND1 PROCESS IT AS ID CARD @VA03112 01619000
CMDCK EQU * @VA03112 01620000
LR R2,R1 POINTER INTO R2 @VA03112 01621000
BAL R14,DECM DECOMPRESS - JUST IN CASE @VA03112 01622000
LR R1,R2 POINTER BACK INTO R1 @VA03112 01623000
BAL R14,COMMANDS MAY BE A COMMAND CHECK IT 01624000
B PUTSKIP SKIP 01625000
SPACE 1 01626000
FOUND1 EQU * 01627000
LR R0,R8 BUFFER LENGTH INTO R0 @VA03112 01628000
TM PUTFLAGS,SPACMP SPACE COMPRESSION ? @VA03112 01629000
BNO NOCOMP NOPE @VA03112 01630000
LR R2,R6 POINTER INTO R2 @VA03112 01631000
BAL R14,DECM GO DECOMPRESS @VA03112 01632000
LR R6,R2 PONTER BACK INTO R6 @VA03112 01633000
NOCOMP EQU * @VA03112 01634000
LR R15,R5 SAVE R5 01635000
LA R3,9(R6) FIRST USERID POSITION 01636000
LR R5,R0 GET BUFFER LENGTH @VA03112 01637000
LA R5,0(R5,R6) CALCULATE LAST POSITION @VA03112 01638000
BAL R14,PARMGET FRAME IT 01639000
CLR R3,R5 ANYTHING THERE? 01640000
LR R5,R15 RESTORE CHAR COUNT @VA03740 01641000
BNL PUTSKIP SKIP THE CARD 01642000
SLR R4,R3 CALCULATE THE LENGTH 01643000
CL R4,=F'8' TOO LONG? 01644000
BH PUTSKIP YES - SKIP IT 01645000
LA R3,1(R4,R3) POINT TO START OF TAG STRING 01646000
BCTR R4,0 DOWN BY ONE FOR CHAR OP 01647000
EX R4,USERMVC MOVE THE FIELD 01648000
LR R15,R5 SAVE R5 @VA04940 01648500
LR R5,R0 GET BUFFER LENGTH @VA04940 01649000
LA R5,0(R5,R6) CALCULATE END OF BUFFER @VA04940 01649500
BAL R14,PARMGET AND GO FRAME IT @VA04940 01650000
CLR R3,R5 WAS THERE A TAG FIELD? @VA04940 01650500
LR R5,R15 RESTORE CHAR COUNT @VA04940 01651000
BNL PUTOPEN BRANCH IF NO TAG FIELD @VA04940 01651500
SLR R4,R3 DETERMINE THE LENGTH OF TAG @VA04940 01652000
BCTR R4,0 GET CHAR OP @VA04940 01652500
EX R4,TAGMVC MOVE THE TAG @VA04940 01653000
MVC CMDBUF(10),TAGHEAD MOVE IN THE HEADER 01655000
EJECT 01656000
PUTOPEN EQU * 01657000
LA R2,PUNBLK GET THE DEVICE BLOCK ADDR 01658000
L R4,RDEVTAG GET THE READER TAG ADDRESS 01659000
MVC TAGTOVM(8),PUTTOVM MOVE INTO THE TAG 01660000
MSG 144,(AXSLINK,SYSTYPE,LOCATION,PUTTOVM) WRITE MSG@VM01105 01661000
XC RDEVSYNC(4),RDEVSYNC CLEAR SYNC 01662000
MVI RDEVFUN,X'11' OPEN REQUEST CODE 01663000
LA R1,PUNBLK GET THE PUNCH BLOCK ADDR 01664000
L R15,GIVEREQ SYSTEM GIVE ROUTINE 01665000
BALR R14,R15 AND GO EXECUTE IT 01666000
L R15,WAITREQ READY TO WAIT 01667000
BALR R14,R15 AND GO EXECUTE IT 01668000
CLI 0(R1),X'80' DID IT OPEN SUCCESSFULLY? 01669000
BNE PUTCLOSE NO 01670000
OI RDEVFLAG,FILEOPEN SET ON FILE OPEN FLAG 01671000
OI PUTFLAGS,XFERFLG SET ON XFER FLAG @VA03112 01672000
L R13,RDEVFIOA SET THE POINTER TO THE DEV BLK 01673000
TM DEVFEAT,REM2780 IS THIS A 2780? @VA04942 01673300
BZ PUTSKIP BRANCH IF NOT @VA04942 01673450
TM PUTFLAGS,TRANSP TRANSPARENCY? @VA04942 01673600
BO PUTSKIP BRANCH IF SO @VA04942 01673750
OI PUTFLAGS,SPACMP MUST DECOMPRESS FOR EM @VA04942 01673900
B PUTSKIP DO NOT WRITE THE ID RECORD 01674000
SPACE 01675000
PUTWRITE EQU * 01676000
TM PUTFLAGS,TRANSP TRANSPARENCY TRANSMISSION? 01677000
BO PUTNOEM YES - DO NOT CHECK 'EM' 01678000
BCTR R2,0 SET POINTER TO LAST-1 01679000
CLI 0(R2),EM 'EM' CHARACTER 01680000
BNE PUTNOEM CHECK 'EM' TO AVOID THE 01681000
MVI 0(R2),X'40' REMOVE EM CHARACTER 01682000
PUTNOEM EQU * 01683000
LTR R8,R8 EMPTY RECORD? @VA04035 01684000
BNZ PUTDATA NO, PUT IT @VA04035 01684100
CLI 0(R7),IRS IS IT INTER RECORD SEP @VA04035 01684400
BNE PUTSKIP NO, NO BLANK CARD OUTPUT @VA04035 01684500
LA R0,1 INDICATE ONE BYTE OF DATA @VA04035 01684600
MVI OUTCARD,C' ' ONE BYTE OF DATA @VA04035 01684700
LA R6,OUTCARD POINT TO THE DATA @VA04035 01684800
B POINT GO PUT THE BLANK CARD @VA04035 01684900
PUTDATA EQU * @VA04035 01685000
LR R0,R8 BUFFER LENGTH INTO R0 @VA03112 01686000
TM PUTFLAGS,SPACMP IS RECORD BLANK COMPRESSED @VA03112 01687000
BNO POINT NO, SKIP DECOMPRESSION @VA03112 01688000
LR R2,R6 POINTER INTO R2. @VA03112 01689000
BAL R14,DECM GO DECOMPRESS @VA03112 01690000
LR R6,R2 POINTER INTO R6 @VA03112 01691000
POINT EQU * @VA03112 01692000
ST R6,PUTPROG STORE IN CCW 01693000
STH R0,PUTPROG+6 STORE THE COUNT @VA03112 01694000
PUTSCRET EQU * 01695000
MVI PUTPROG,X'01' RESET WRITE OP CODE 01696000
MVC DEVSTART(4),=A(PUTPROG) SET THE CAW 01697000
BAL R14,XECUTE GO TO PUNCH IT 01698000
EJECT 01699000
PUTSKIP EQU * 01700000
TM DEVFEAT,REM2770 IS A 2770 TYPE? 01701000
BO PUTSKIP1 YES..NO ITB 01702000
* NOTE - THE BLOCK CHECK CHARACTER 01704000
* FOLLOWS AN ITB AND IS ZERO FOR A 01705000
* 2780 DEVICE 01706000
TM PUTFLAGS,TRANSP TRANSPARENT? 01707000
BNO PUTSKIP1 NO 01708000
LA R8,2(R8) ADJUST LINE BLOCK POINTER 01709000
LA R7,2(R7) HERE TOO 01710000
PUTSKIP1 EQU * 01711000
CLI TRTFNCBT,ETB WAS ENDING CHAR ETB? @VA04942 01711600
BE NPTTALK1 BRANCH IF SO @VA04942 01712200
CLI TRTFNCBT,ETX WAS ENDING CHAR ETX? @VA04942 01712800
BE NPTTALK1 BRANCH IF SO @VA04942 01713400
TM DEVFEAT,REM2770 IS IT A 2770 TYPE? 01715000
BO PUTSKIP2 YES..SKIP 01716000
LA R7,2(R7) NO - CHECK THE NEXT RECORD 01717000
TM PUTFLAGS,TRANSP TRANSPARENT? @VA03343 01718000
BZ PUTSKP1A BRANCH IF NOT @VA04942 01719150
CR R7,R5 END OF BUFFER? @VA04942 01719300
BNL NPTTALK1 BRANCH IF SO @VA04942 01719450
B TRT1 NO, GO GET NEXT RECORD @VA04942 01719600
PUTSKP1A EQU * @VA04942 01719750
CLI 0(R7),STX OPTIONAL STX? @VA03343 01720000
BNE TRT1 NO - ALL SET @VA03343 01721000
LA R7,1(,R7) YES - ADJUST FOR STX @VA03343 01722000
B TRT1 AND CONTINUE 01724000
SPACE 1 01725000
PUTSKIP2 EQU * 01726000
TM PUTFLAGS,TRANSP ARE WE TRANSMITTING TRANS 01727000
BZ PUTSKP2A BRANCH IF NOT @VA04942 01728150
CR R7,R5 AT END OF BUFFER? @VA04942 01728300
BNL NPTTALK1 BRANCH IF SO @VA04942 01728450
B TRT1 NO, GO GET NEXT RECORD @VA04942 01728600
PUTSKP2A EQU * @VA04942 01728750
LA R7,1(R7) OVER EM CHARACTER 01729000
B TRT1 AND CONTINUE 01730000
* 01731000
USERMVC MVC PUTTOVM(0),9(R6) MOVE ID NAME 01732000
TAGMVC MVC CMDBUF+10(0),0(R3) TO BE EXECUTED FROM ABOVE 01733000
TRT TRT 0(0,R7),TAB TO BE EXECUTED FROM ABOVE 01734000
* 01735000
PUTCLOSE DS 0H 01736000
LA R2,PUNBLK AND PUNCH DEV POINTER 01737000
L R13,RDEVFIOA SET OUT DEV POINTER 01738000
TM RDEVFLAG,FILEOPEN FILE OPEN? 01739000
BO PUTCLS1 YES 01740000
TM SELFLAGS,VCMD WAS A VALID COMMAND ENTERED @VA04171 01740300
BO PUTCLS4 YES, SKIP THE NO ID MSG @VA04171 01740600
MSG 934,AXSLINK WRITE ERROR MSG 01741000
B PUTCLS4 AND CONTINUE 01742000
EJECT 01743000
PUTCLS1 EQU * 01744000
UNPK CMDBUF+5(5),DEVADDR(3) UNPK THE DEVICE ADDR 01745000
MVI CMDBUF+5,C' ' RESTORE THE CLOBBERED BLANK 01746000
MVI CMDBUF+9,C' ' RESTORE THE CLOBBERED BLANK 01747000
TR CMDBUF+6(3),AXSTRTAB-240 TRANSLATE TO LEGAL EBCDIC 01748000
LA R1,CMDBUF GET THE COMMAND ADDR 01749000
LA R2,80 USE THIS LENGTH 01750000
DIAG R1,R2,X'08' AND WRITE TO CP 01751000
MSG 145,(AXSLINK,SYSTYPE,LOCATION,PUTTOVM) WRITE MSG@VM01105 01752000
LA R2,PUNBLK GET PUN REQ BLOCK ADDR 01753000
XC RDEVSYNC(4),RDEVSYNC CLEAR SYNC 01754000
MVI RDEVFUN,X'12' CLOSE REQUEST CODE 01755000
LA R1,PUNBLK GET THE DEVICE BLOCK ADDR 01756000
L R15,GIVEREQ SYSTEM GIVE ROUTINE 01757000
BALR R14,R15 AND EXECUTE IT 01758000
L R15,WAITREQ SYSTEM WAIT ROUTINE 01759000
BALR R14,R15 AND EXECUTE IT 01760000
SPACE 01761000
L R4,RDEVTAG GET TAG POINTER @VA03522 01762000
MVC TAGTOVM(8),FILL BLANK TAG AREA 01763000
MVC PUTTOVM(8),FILL BLANK TAG AREA 01764000
PUTCLS4 EQU * 01765000
NI NPTFLAGS,X'FF'-MSGREC RESET RECEIVING FLAG 01766000
NI RDEVFLAG,X'FF'-FILEOPEN RESET FILE OPEN FLAG 01767000
MVI PUTFLAGS,X'00' RESET FLAGS 01768000
NI LINERROR,WACKREC RESET ALL BUT WACK FLG @VA08288 01769100
NI SELFLAGS,X'FF'-VCMD RESET VALID CMD FLAG @VA04171 01769500
PUTCLS2 EQU * 01770000
LA R13,LINE GET LINE DEVICE TABLE 01771000
LA R8,NPTCHARG RESET RETURN ADDRESS 01772000
TM INTFLAG,INTOUT HERE AFTER INTERRUPTION 01773000
BO PUTENQ YES RESTART OUTPUT 01774000
LA R2,RDRBLK POINTER TO READER BLOCK 01775000
TM RDEVFLAG,FILACTIV INITIAL TRANSMISSION PENDING? 01776000
BO NPTSTART YES - GO TO START IT 01777000
B NPTDINIT NO - GO TO FIND SOMETHING TO DO 01778000
EJECT 01779000
***************************************************************** 01780000
** ** 01781000
** SUBROUTINE TO DECOMPRESS A CARD IMAGE ** 01782000
** INPUT: R2 = ADDR OF COMPRESSED DATA ** 01783000
** OUTPUT: R2 = ADDR OF DECOMPRESSED DATA ** 01784000
** R1 = ADDR OF SCAN TERMINATION ** 01785000
** ** 01786000
***************************************************************** 01787000
SPACE 01788000
DECM EQU * @VA03112 01789000
STM R3,R5,DECMSAVE SAVE REGISTERS @VA03112 01790000
LR R3,R2 R3 = FIRST SOURCE DATA CHARACTER @VA03112 01791000
LA R4,OUTCARD R4 = SINK ADDRESS @VA03112 01792000
MVI TAB+X'1D',X'1D' SET TABLE FOR IGS @VA03112 01793000
SLR R1,R1 CLEAR FOR TRT ADDRESS @VA03643 01794000
TRT 0(80,R3),TAB IF NO TERMINATION CHARACTER, @VA03112 01795000
BZ DECM20 (IN 80 BYTES) GO MOVE 80 BYTES @VA03112 01796000
MVI 0(R4),C' ' CLEAR THE @VA03112 01797000
MVC 1(79,R4),0(R4) SINK AREA @VA03112 01798000
LR R5,R4 R5 = START OF SINK AREA @VA03112 01799000
SPACE 01800000
DECM10 LA R2,1(,R3) COMPUTE FIELD LENGTH FOR MVC @VA03112 01801000
LCR R2,R2 A(TERMINATOR) MINUS @VA03112 01802000
AR R2,R1 A(START OF FIELD) MINUS ONE @VA03112 01803000
BM *+8 IF FIELD LENGTH NEGATIVE, SKIP. @VA03112 01804000
EX R2,DECMMVC MOVE THE FIELD. @VA03112 01805000
CLI 0(R1),IGS IF TERMINATOR SAYS END-OF- @VA03112 01806000
BNE DECM30 RECORD, BRANCH. @VA03112 01807000
LA R3,3(R2,R3) IGS - POINT R3 TO NEXT FIELD @VA03112 01808000
LA R5,1(R2,R5) AS WELL AS SINK AREA POINTER @VA04032 01809000
IC R2,1(,R1) GET BLANK COUNT. @VA03112 01810000
N R2,=F'63' CLEAN IT UP. @VA03112 01811000
AR R5,R2 ADD IT TO SINK AREA POINTER. @VA03112 01812000
LA R2,79(,R4) COMPUTE POTENTIAL MAXIMUM @VA03112 01813000
SR R2,R5 LENGTH OF REMAINING INPUT (-1). @VA03112 01814000
BM DECM30 BRANCH IF LENGTH IS ZERO. @VA03112 01815000
STC R2,*+L'*+1 SET SCAN LENGTH. @VA03112 01816000
TRT 0(*-*,R3),TAB SEARCH FOR TERMINATOR. @VA03112 01817000
BNZ DECM10 BRANCH IF FOUND. @VA03112 01818000
EX R2,DECMMVC MOVE LAST FIELD TO CALLER. @VA03112 01819000
B DECM30 GO CLEANUP AND RETURN @VA03112 01820000
SPACE 01821000
DECM20 MVC 0(80,R4),0(R3) MOVE 80 BYTES TO SINK. @VA03112 01822000
LA R1,80(0,R3) POINT TO TERMINATION CHAR @VA03349 01823000
SPACE 01824000
DECM30 LR R2,R4 RETURN POINTER IN R2. @VA03112 01825000
MVI TAB+X'1D',X'00' RESET IGS IN TABLE @VA03112 01826000
LA R0,80 SET LENGTH TO 80 BYTES @VA03112 01827000
LM R3,R5,DECMSAVE RESTORE REGS 3-5 @VA03112 01828000
BR R14 RETURN. @VA03112 01829000
SPACE 2 01830000
DECMSAVE DS 3F REGISTER SAVE @VA03112 01831000
DECMMVC MVC 0(*-*,R5),0(R3) EXECUTED MVC. @VA03112 01832000
EJECT 01833000
***************************************************************** 01834000
** ** 01835000
** SUBROUTINE TO COMPRESS A PRINT LINE ** 01836000
** INPUT: R1 = ADDRESS, R0 = LENGTH ** 01837000
** OUTPUT: R1 = ADDRESS, R0 = LENGTH ** 01838000
** ** 01839000
***************************************************************** 01840000
SPACE 01841000
CMPR EQU * @VA03112 01842000
STM R2,R4,CMPRSAVE SAVE REGISTERS 2-4. @VA03112 01843000
OC 0(2,R1),=X'4040' INSURE NO BISYNC CHARACTERS. @VA03112 01844000
CL R0,=F'2' IS LINE LONGER THAN TWO... @VA03112 01845000
BNH CMPR60 BRANCH IF NOT. @VA03112 01846000
LR R2,R0 R2 = LINE LENGTH. @VA03112 01847000
EX R2,CMPRMVC1 MOVE LINE TO WORK AREA. @VA03112 01848000
EX R2,CMPROC INSURE NO BISYNCH CHARACTERS @VA03112 01849000
LA R1,CMPRWORK R1 = ADDR OF COMPRESSED LINE. @VA03112 01850000
LR R3,R1 R3 = ADDR OF UNCOMPRESSED LINE. @VA03112 01851000
SPACE 01852000
CMPR10 CLI 0(R3),C' ' LOOK FOR START OF BLANK FIELD. @VA03112 01853000
BNE CMPR40 BRANCH IF NOT BLANK START. @VA03112 01854000
LA R0,63 R0 = MAX BLANK FIELD LENGTH. @VA03112 01855000
LR R4,R3 R4 = ADDR OF FIRST BLANK. @VA03112 01856000
B *+12 GO SCAN FOR MORE BLANKS. @VA03112 01857000
SPACE 01858000
CMPR20 CLI 0(R3),C' ' DOES BLANK FIELD CONTINUE... @VA03112 01859000
BNE CMPR30 BRANCH IF NOT. @VA03112 01860000
LA R3,1(,R3) INCREMENT SCAN ADDRESS. @VA03112 01861000
BCT R2,CMPR25 BRANCH IF NOT END OF LINE. @VA03112 01862000
LR R0,R4 R0 = ADDR OF LINE END +1. @VA03112 01863000
B CMPR50 GO COMPUTE COMPRESSED LENGTH. @VA03112 01864000
SPACE 01865000
CMPR25 BCT R0,CMPR20 LOOP IF MAX FIELD NOT EXCEEDED. @VA03112 01866000
SPACE 01867000
CMPR30 LR R0,R3 R0 = ADDR OF FIELD END +1. @VA03112 01868000
SLR R0,R4 R0 = BLANK FIELD LENGTH. @VA03112 01869000
CL R0,=F'2' IS FIELD LONGER THAN TWO... @VA03112 01870000
BNH CMPR40 BRANCH IF NOT. @VA03112 01871000
MVI 0(R4),IGS SET GROUP SEPARATOR AT +0. @VA03112 01872000
STC R0,1(,R4) SET BLANK COUNT AT +1. @VA03112 01873000
OI 1(R4),X'40' TURN ON X'40' BIT AT +1. @VA03112 01874000
EX R2,CMPRMVC2 SHIFT REMAINDER OF LINE LEFT. @VA03112 01875000
LA R3,2(,R4) R3 = ADDR OF REMAINDER OF LINE. @VA03112 01876000
B CMPR10 GO LOOK AGAIN FOR BLANK FIELD. @VA03112 01877000
SPACE 01878000
CMPR40 LA R3,1(,R3) INCREMENT SCAN ADDRESS. @VA03112 01879000
BCT R2,CMPR10 LOOP IF LINE NOT EXHAUSTED. @VA03112 01880000
SPACE 01881000
LR R0,R3 R0 = ADDR OF LINE END +1. @VA03112 01882000
CMPR50 SLR R0,R1 R0 = COMPRESSED LINE LENGTH. @VA03112 01883000
SPACE 01884000
CMPR60 LM R2,R4,CMPRSAVE RESTORE REGISTERS. @VA03112 01885000
BR R14 RETURN. @VA03112 01886000
SPACE 2 01887000
CMPRMVC1 MVC CMPRWORK(*-*),0(R1) FIRST EXECUTED MVC @VA03112 01888000
CMPRMVC2 MVC 2(*-*,R4),0(R3) SECOND EXECUTED MVC @VA03112 01889000
CMPROC OC CMPRWORK(*-*),=CL168' ' EXECUTED OC @VA03112 01890000
CMPRWORK DS 21D WORK AREA @VA03112 01891000
CMPRSAVE DS 3F REGISTER SAVE AREA. @VA03112 01892000
SPACE 2 01893000
SPACE 1 01894000
DROP R4 DROP TAG ADDRESSABILTIY 01895000
SPACE 01896000
PUTTOVM DC CL8' ' SAVE AREA FOR TOVMID 01897000
TAGHEAD DC C'TA DE XXX ' TAG HEADER 01898000
EJECT 01899000
*. 01900000
* 01901000
* ENTRY NAME - 01902000
* 01903000
* RECVRFY 01904000
* 01905000
* FUNCTION - 01906000
* 01907000
* THIS ROUTINE VERIFYS THE CONTENT OF EACH RECEIVED T/P BUFFER 01908000
* AND CONSTRUCTS AN APPROPRIATE REPLY IF THE BUFFER IS FOUND 01909000
* IN ERROR. 01910000
* 01911000
* CALLS TO OTHER ROUTINES - 01912000
* 01913000
* NONE 01914000
* 01915000
* OPERATION - 01916000
* 01917000
* 1. CHECK FOR IOERR AND TAKE CORRECTIVE ACTION IF NECESSARY 01918000
* 01919000
* 2. CHECK RECEIVED BUFFER FOR CORRECT ENEVLOPE OF BSC 01920000
* CONTROL CHARACTERS, IF OKAY EXIT TO PUTBLOCK. 01921000
* 01922000
* 3. IF BLOCK NOT CORRECT SEND NAK AND WAIT FOR REPLY. 01923000
* 01924000
* RESPONSES - 01925000
* 01926000
* NONE 01927000
* 01928000
* ERROR MESSAGES - 01929000
* 01930000
* NONE 01931000
* 01932000
*. 01933000
SPACE 3 01934000
RECVRFY EQU * @VA03349 01935000
TM DEVFLAGS,IOERR ANY ERROR? 01936000
BNO CKBUFF NO-CHECK THE BUFFER 01937000
TM DEVSENSE,DATACK WAS IT A DATA CHECK? @VA05798 01937100
BNZ NPTNAKSD YES, ASK FOR RETRANSMISSION @VA05798 01937400
TM DEVSENSE,TIMEOUT WAS THE PROBLEM TIMEOUT? 01938000
BNO SENDPROG @VA05798 01939000
BCTR R15,0 YES - UPDATE THE TIMEOUT COUNT 01940000
LTR R15,R15 END OF TIMEOUT RETRY? 01941000
BZ PUTCLOSE YES - GO TO CLOSE THE FILE 01942000
* NO - TRY AGAIN 01943000
B LISTENQ READ, WAIT FOR ENQ @VA06238 01944500
SPACE 1 01947000
SENDPROG EQU * 01948000
BAL R14,LINEIO GO DO THE IO @VA03349 01949000
B RECVRFY GO CHECK THE OPERATION @VA03349 01950000
NPTNAK1 EQU * @VA05664 01950100
XI RESP+1,X'11' RESET ACK RESPONSE @VA05664 01950200
EJECT 01951000
NPTNAK EQU * 01952000
LA R13,LINE ASSURE THE DEVICE POINTER 01953000
BCTR R15,0 UPDATE THE NAK COUNT 01954000
LTR R15,R15 END OF NAK RETRY? 01955000
BZ REPLYEOT YES - TRY TO RESET THE LINE 01956000
NPTNAKSD EQU * 01957000
MVC DEVSTART(4),=A(NAKPROG) SEND THE NAK AND LISTEN 01958000
B SENDPROG AND CONTINUE 01959000
SPACE 2 01960000
CKBUFF EQU * 01961000
CLI LINEINB,STX FIRST CHARACTER STX OR 01962000
BE OK3 YES 01963000
CLC LINEINB(2),=X'1002' DLE STX? 01964000
BNE NOK NO - CHECK IT 01965000
OI PUTFLAGS,TRANSP SET ON TRANSP. FLAG 01966000
OK3 EQU * 01967000
LA R5,BUFFLEN GET BUFFER LENGTH 01968000
SH R5,DEVCSW+6 SUBSTACT OUT RESIDUAL COUNT 01969000
LA R14,LINEINB GET THE START OF THE INPUT BUFFER 01970000
BCTR R5,0 DOWN BY ONE 01971000
AR R14,R5 ENQ IS NOT FOLLOWED BY BCC @VA03349 01972000
CLI 0(R14),ENQ BAD INPUT RECORD @VA03349 01973000
BE NPTNAKSD YES, ASK FOR RETRANSMISSION @VA03349 01974000
BCTR R14,0 @VA03349 01976000
LR R5,R14 POINT TO END OF BUFFER @VA04942 01976500
CLI 0(R14),ETB IS IT ETB OR 01977000
BE PUTBLOCK END OK? 01978000
CLI 0(R14),ETX ETX? 01979000
BE SETETX YES,INDICATE ETX RECEIVED @VA03349 01980000
CLI 0(R14),EOT ABORT TRANSMISSION @VA03349 01981000
BE NPTDINIT YES, GO START OVER @VA03349 01982000
B TROUBLE @VA03349 01983000
SETETX EQU * @VA03349 01984000
OI PUTFLAGS,ETXREC YES, FLAG ETX REC'D @VA03119 01985000
B PUTBLOCK ...AND ACCEPT RECORD @VA03119 01986000
TROUBLE TM DEVFEAT,REM2770 NO, INPUT DEVICE TROUBLE @VA03119 01987000
BNO REPLYEOT 2780 GETS AN EOT @VA03119 01988000
OI PUTFLAGS,NTRDY TRANSMISSION INTERRUPTED @VA03119 01989000
B NPTNAKSD SEND NAK FOR 2770-LIKE TERMINALS @VA03119 01990000
SPACE 01991000
REPLYEOT EQU * 01992000
MVC RESP(2),INITACK0 SET INITIAL REPLY TO DEV @VA03349 01993000
LA R15,RETRYNUM RESET THE RETRY COUNTER 01994000
REPLY2 EQU * 01995000
MVC DEVSTART(4),=A(NRDYPROG) SEND EOT AND 01996000
BAL R14,LINEIO LISTEN FOR 2780 01997000
TM DEVFLAGS,IOERR ANY ERROR? 01998000
BO REPLY3 YES - CHECK IT 01999000
CLI LINEINB,ENQ ENQ RECEIVED? 02000000
BNE REPLY2 NO 02001000
B NPTTALK1 AND CONTINUE 02002000
SPACE 02003000
REPLY3 EQU * 02004000
TM DEVSENSE,TIMEOUT IS THE PROBLEM TIMEOUT? 02005000
BNO REPLY2 NO - RETRY THE RESET 02006000
BCTR R15,0 YES - UPDATE THE TIMEOUT COUNT 02007000
LTR R15,R15 END OF RETRY 02008000
BP REPLY2 NO - TRY AGAIN 02009000
B PUTCLOSE YES - GO TO CLOSE THE FILE 02010000
EJECT 02011000
NOK EQU * 02012000
CLI LINEINB,ENQ ENQ RECEIVED? 02013000
BE NPTTALK1 YES 02014000
CLI LINEINB,EOT EOT RECEIVED? 02015000
BE PUTBKEOT YES 02016000
CLI LINEINB,NAK NAK RECEIVED @VA03349 02017000
BE PUTBKEOT YES 02018000
CLC LINEINB(2),=AL1(STX,ENQ) IS IT A TEMP DELAY @VA03349 02019000
BE NPTNAKSD YES, RESPOND WITH A NAK @VA03349 02020000
SPACE 02021000
LISTENQ EQU * @VA03119 02022000
LA R13,LINE GET LINE DEVICE BLOCK ADDR 02023000
MVC DEVSTART(4),=A(RDONLYPG) READ ONLY - NO STX 02024000
BAL R14,LINEIO GO START THE IO @VA03349 02025000
B RECVRFY @VA03349 02026000
SPACE 02027000
NPTTALK1 EQU * 02028000
LA R15,RETRYNUM RESET RETRY COUNTER 02029000
LA R13,LINE GET LINE DEVICE BLOCK ADDR 02030000
MVC DEVSTART,=A(RECEIVE) SET UP TO RECEIVE FROM @VA03349 02031000
* DEVICE 02032000
BAL R14,LINEIO START UP THE CHANNEL PROGRAM @VA03349 02033000
B RECVRFY @VA03349 02034000
SPACE 1 02035000
PUTBKEOT EQU * 02036000
MVC EXPRESP(2),INITACK0 INIT EXPECTED RESPONSE @VA03349 02037000
MVC RESP(2),INITACK0 INITIALIZE RESPONSE TO DEVICE @VA03349 02038000
TM PUTFLAGS,ETXREC ETX REC'D ? @VA03119 02039000
BO RESET YES, ALL THROUGH @VA03119 02040000
TM PUTFLAGS,NTRDY TRANSMISSION INTERRUPTED ? @VA03119 02041000
BNO LISTENQ NO, SEE WHAT'S UP @VA03119 02042000
NI PUTFLAGS,255-NTRDY RESET FLAG @VA03119 02043000
SLR R15,R15 SET TO WAIT A LONG TIME @VA03649 02044000
B LISTENQ GO LISTEN FOR ENQ @VA03119 02045000
RESET NI PUTFLAGS,255-(ETXREC+SPACMP) RESET THESE FLAGS @VA03112 02046000
OI PUTFLAGS,EOTREC EOT RECEIVED 02047000
B PUTBLOCK AND GO PUT THE BLOCK 02048000
EJECT 02049000
*. 02050000
* 02051000
* ENTRY NAME - 02052000
* 02053000
* COMMANDS 02054000
* 02055000
* FUNCTION - 02056000
* 02057000
* THIS ROUTINE PASSES COMMANDS RECEIVED FROM THE REMOTE 02058000
* CARD READER TO THE RSCS COMMAND EXECUTATOR FOR PROPER 02059000
* ACTION. 02060000
* 02061000
* CALLS TO OTHER ROUTINES - 02062000
* 02063000
* DMTREX - FOR COMMAND EXECUTION 02064000
* 02065000
* OPERATION - 02066000
* 02067000
* 1. MOVE COMMAND TO GIVE REQUEST BUFFER. 02068000
* 02069000
* 2. INITIATE A CALL TO DMTREX TO PROCESS THE COMMAND. 02070000
* 02071000
* 3. WAIT FOR COMPLETION. 02072000
* 02073000
* 4. RETURN TO CALLER. 02074000
* 02075000
* RESPONSES - 02076000
* 02077000
* NONE 02078000
* 02079000
* ERROR MESSAGES - 02080000
* 02081000
* NONE 02082000
* 02083000
*. 02084000
SPACE 3 02085000
COMMANDS EQU * 02086000
STM R14,R1,RCMDSAVE SAVE CALLER REGISTERS 02087000
MVC CMDBUF(80),0(R1) MOVE INTO COMMAND BUF 02088000
XC CMDGIV(4),CMDGIV CLEAR SYNCH LOCK 02089000
LR R14,R8 GET THE LENGTH OF COMMAND 02090000
LA R14,3(R14) ADD IN THE HEADER 02091000
STC R14,CMDREQ AND STORE IN GIVE REQUEST BUFFER 02092000
LA R1,CMDGIV INITIATE GIVE 02093000
SR R0,R0 INDICATE GIVE 02094000
L R15,GIVEREQ SYSTEM GIVE REQUEST 02095000
BALR R14,R15 DO THE GIVE 02096000
L R15,WAITREQ SYSTEM WAIT PROCESSOR 02097000
BALR R14,R15 AND DO THE WAIT 02098000
MVI CMDBUF,C' ' BLANK THE FIRST BYTE 02099000
MVC CMDBUF+1(79),CMDBUF AND THE REST 02100000
LM R14,R1,RCMDSAVE RESTORE REGS 02101000
BR R14 AND RETURN 02102000
SPACE 02103000
CMDGIV DC F'0' SYNCH LOCK 02104000
DC CL4'REX ' GIVE TO REX 02105000
DC A(CMDREQ) REQUEST BUFFER 02106000
DC A(0) RESPONSE BUFFER 02107000
SPACE 02108000
CMDREQ DC AL1(83),X'00',AL2(0) 02109000
CMDBUF DC CL80' ' COMMAND BUFFER 02110000
SPACE 1 02111000
RCMDSAVE DS 10F REGISTER SAVE AREA @VA03745 02112000
EJECT 02113000
*. 02114000
* 02115000
* ENTRY NAME - 02116000
* 02117000
* CMDPROC 02118000
* 02119000
* FUNCTION - 02120000
* 02121000
* THIS ROUTINE EXECUTES COMMANDS PASSED TO IT IN THE 02122000
* CMDRESP BUFFER AFTER AN ALERT FROM DMTREX INDICATING A 02123000
* CMD HAS BEEN ENTERED. 02124000
* 02125000
* CALLS TO OTHER ROUTINES - 02126000
* 02127000
* NONE 02128000
* 02129000
* OPERATION - 02130000
* 02131000
* 1. SCAN COMMAND TABLE FOR MATCH. 02132000
* 02133000
* 2. IF FOUND BRANCH TO APPROPRIATE SUBROUTINE TO PROCESS 02134000
* COMMAND. 02135000
* 02136000
* 3. UPON RETURN RESET COMMAND IN PROGRESS SWTICH AND RETURN. 02137000
* 02138000
* RESPONSES - 02139000
* 02140000
* SEE EACH SUBROUTINE 02141000
* 02142000
* ERROR MESSAGES - 02143000
* 02144000
* SEE EACH SUBROUTINE 02145000
* 02146000
*. 02147000
SPACE 3 02148000
DS 0H 02149000
CMDPROC EQU * 02150000
STM R14,R7,RCMDSAVE SAVE CALLER REGISTERS @VA03745 02151000
LM R3,R5,CMDSETUP PREPARE FOR COMMAND SCAN 02152000
CMDSCAN EQU * 02153000
CLC 0(1,R3),CMDRESP+1 IS IT THIS ONE 02154000
BE CMDCALL YES 02155000
BXLE R3,R4,CMDSCAN PREPARE FOR NEXT COMPARE 02156000
B CMDRET COMMAND NOT FOUND IGNORE 02157000
SPACE 02158000
CMDCALL EQU * 02159000
OI SELFLAGS,VCMD INDICATE A VALID COMMAND ENTERED @VA04171 02159500
L R7,NPTALINK GET LINK TABLE ENTRY 02160000
MVC MSGLINK(8),CMDRESP+4 MOVE IN RESPONSE LINKID 02161000
LA R2,RDRBLK GET READER REQUEST BLOCK ADDR 02162000
L R15,0(R3) GET ROUTINE TO CALL 02163000
BALR R14,R15 GO EXECUTE THE COMMAND 02164000
EJECT 02165000
CMDRET EQU * 02166000
MVI CMDINPGS,X'00' RESET COMMAND IN PROGRESS SWITCH 02167000
MVI MSGLINK,X'00' RESET RESPONSE LINKID @VA03741 02168000
LM R14,R7,RCMDSAVE RESTORE CALLER REGISTERS @VA03745 02169000
BR R14 AND RETURN 02170000
EJECT 02171000
*---------------------------------------------------------------------* 02172000
* START COMMAND * 02173000
*---------------------------------------------------------------------* 02174000
*. 02175000
* RESPONSES - 02176000
* 02177000
* DMTNPT752I LINK 'LINKID' STILL ACTIVE -- DRAIN STATUS 02178000
* RESET 02179000
* 02180000
* ERROR MESSAGES - 02181000
* 02182000
* DMTNPT750E LINK 'LINKID' ALREADY ACTIVE -- NO ACTION TAKEN 02183000
* 02184000
*. 02185000
SPACE 1 02186000
SETSTART EQU * 02187000
ST R14,CMDCMDSV SAVE RETURN REG 02188000
TM LFLAG,LDRAIN ARE WE DRAINING? 02189000
BNO SETSTRT1 NO 02190000
NI LFLAG,255-LDRAIN RESET DRAIN FLAG 02191000
MSG 752,AXSLINK AND WRITE MSG 02192000
B SETSTRTE AND EXIT 02193000
SPACE 1 02194000
SETSTRT1 EQU * 02195000
CLI CMDRESP+3,STACLASS IS IT A CLASS RESET? 02196000
BE SETSTRTE YES..NO MSG 02197000
MSG 750,AXSLINK WRITE MSG 02198000
SETSTRTE EQU * 02199000
OI RDEVFLAG,FILREADY SET FILE READY FLAG 02200000
L R14,CMDCMDSV RESTORE RETURN REG 02201000
BR R14 AND RETURN 02202000
EJECT 02203000
*---------------------------------------------------------------------* 02204000
* DRAIN COMMAND * 02205000
*---------------------------------------------------------------------* 02206000
*. 02207000
* RESPONSES - 02208000
* 02209000
* DMTNPT570I LINK 'LINKID' NOW SET TO DEACTIVATE 02210000
* 02211000
* ERROR MESSAGES - 02212000
* 02213000
* DMTNPT571E LINK 'LINKID' ALREADY SET TO DEACTIVATE 02214000
* 02215000
*. 02216000
SPACE 1 02217000
SETDRAIN EQU * 02218000
ST R14,CMDCMDSV SAVE RETURN 02219000
TM LFLAG,LDRAIN ALREADY DRAINING? 02220000
BO SETDRER1 YES ..ERROR 02221000
OI LFLAG,LDRAIN SHOW WE ARE DRAINING 02222000
MSG 570,AXSLINK WRITE MSG 02223000
TM INTFLAG,SIGNONED HAVE WE SIGNON YET? 02224000
BNO LINEDIS2 EARLY TERMINATION 02225000
NI INTFLAG,X'FF'-SIGNONED TURN OFF FLAG @VA08251 02226000
B LINEDIS2 CLEAN UP LINK @VA08251 02226100
SPACE 02227000
SETDRER1 EQU * 02228000
MSG 571,AXSLINK WRITE ERROR MSG 02229000
SETDRXIT EQU * 02230000
L R14,CMDCMDSV RESTORE RETURN REG 02231000
BR R14 AND RETURN 02232000
EJECT 02233000
*---------------------------------------------------------------------* 02234000
* FREE COMMAND * 02235000
*---------------------------------------------------------------------* 02236000
*. 02237000
* RESPONSES - 02238000
* 02239000
* DMTNPT590I LINK 'LINKID' RESUMING FILE TRANSFER 02240000
* 02241000
* ERROR MESSAGES - 02242000
* 02243000
* DMTNPT591E LINK 'LINKID' NOT IN HOLD STATUS 02244000
* 02245000
*. 02246000
SPACE 1 02247000
SETFREE EQU * 02248000
ST R14,CMDCMDSV SAVE RETURN 02249000
TM LFLAG,LHOLD ARE WE HELD? 02250000
BNO SETFRER1 NO ERROR 02251000
MSG 590,AXSLINK WRITE FREE MSG 02252000
NI LFLAG,255-LHOLD TURN OFF HOLD FLAG 02253000
TM RDRCMD,RHLDIPGS WAS THE HOLD IMMED? 02254000
BO SETFRXIT YES..ALL DONE 02255000
OI RDEVFLAG,FILREADY SET FILE READY FLAG 02256000
B SETFRXIT AND ENTER COMMON EXIT 02257000
SPACE 1 02258000
SETFRER1 EQU * 02259000
MSG 591,AXSLINK NOT IN HOLD MSG 02260000
SETFRXIT EQU * 02261000
NI RDRCMD,255-RHLDIPGS TURN OFF FLAG 02262000
L R14,CMDCMDSV RESTORE RETURN 02263000
BR R14 AND RETURN 02264000
EJECT 02265000
*---------------------------------------------------------------------* 02266000
* HOLD COMMAND * 02267000
*---------------------------------------------------------------------* 02268000
*. 02269000
* RESPONSES - 02270000
* 02271000
* DMTNPT610I LINK 'LINKID' TO SUSPEND FILE TRANSMISSION 02272000
* DMTNPT611I LINK 'LINKID' FILE TRANSMISSION SUSPENDED 02273000
* 02274000
* ERROR MESSAGES - 02275000
* 02276000
* DMTNPT612E LINK 'LINKID' ALREADY IN HOLD STATUS 02277000
* 02278000
*. 02279000
SPACE 1 02280000
SETHOLD EQU * 02281000
ST R14,CMDCMDSV SAVE RETURN 02282000
TM LFLAG,LHOLD ALREADY IN HOLD? 02283000
BO SETHLDE1 YES ERROR 02284000
TM CMDRESP+3,HOLDIMM HOLD IMMEDIATE? 02285000
BO SETHLDIM YES PROCESS IT 02286000
TM RDEVFLAG,FILACTIV IS THERE A FILE ACTIVE? @VM01139 02287000
BNO SETHLDIM NO..CAN DO IT ALL NOW 02288000
OI RDRCMD,RHLDIPGS MARK HOLD IN PROGRESS 02289000
MSG 610,AXSLINK WRITE SET TO HOLD MSG 02290000
B SETHLDXT AND ENTER COMMON EXIT 02291000
SPACE 1 02292000
SETHLDIM EQU * 02293000
OI LFLAG,LHOLD HOLD IT REGARDLESS 02294000
MSG 611,AXSLINK WRITE HELD MSG 02295000
B SETHLDXT AND ENTER COMMON EXIT 02296000
EJECT 02297000
SETHLDE1 EQU * 02298000
MSG 612,AXSLINK WRITE ALREADY HELD MSG 02299000
SETHLDXT EQU * 02300000
MVC HLDCMDLK(8),CMDRESP+4 SAVE RESPONSE LINK @VA03277 02301000
L R14,CMDCMDSV RESTORE RETURN 02302000
BR R14 AND RETURN 02303000
EJECT 02304000
*---------------------------------------------------------------------* 02305000
* TRACE COMMAND * 02306000
*---------------------------------------------------------------------* 02307000
*. 02308000
* RESPONSES - 02309000
* 02310000
* DMTNPT801I LINK 'LINKID' ERROR TRACE STARTED 02311000
* DMTNPT802I LINK 'LINKID' TRACE STARTED 02312000
* DMTNPT803I LINK 'LINKID' TRACE ENDED 02313000
* 02314000
* ERROR MESSAGES - 02315000
* 02316000
* DMTNPT810E LINK 'LINKID' TRACE ALREADY ACTIVE 02317000
* DMTNPT811E LINK 'LINKID' TRACE NOT ACTIVE 02318000
* 02319000
*. 02320000
SPACE 1 02321000
SETTRACE EQU * 02322000
ST R14,CMDCMDSV SAVE RETURN REGISTER 02323000
CLI CMDRESP+3,TRACEOFF TRACE OFF? 02324000
BNE SETTR1 NO CONTINUE 02325000
TM LFLAG,LTRALL+LTRERR ARE WE TRACING AT ALL? 02326000
BZ SETTRE2 NO ERROR 02327000
NI LFLAG,255-LTRALL-LTRERR TURN OFF TR BITS 02328000
MSG 803,AXSLINK WRITE THE MSG 02329000
B SETTRXIT AND EXIT 02330000
SPACE 02331000
SETTR1 EQU * 02332000
TM LFLAG,LTRALL+LTRERR ARE WE TRACING ALREADY? 02333000
BM SETTRE1 YES ERROR 02334000
CLI CMDRESP+3,TRACERR ERROR TRACING? 02335000
BNE SETTR2 NO ERROR 02336000
OI LFLAG,LTRERR SET ERROR TRACE ON 02337000
MSG 801,AXSLINK WRITE MSG 02338000
B SETTRXIT AND EXIT 02339000
EJECT 02340000
SETTR2 EQU * 02341000
OI LFLAG,LTRALL SET TRACE ALL 02342000
MSG 802,AXSLINK AND WRITE MSG 02343000
B SETTRXIT AND EXIT 02344000
SPACE 02345000
SETTRE1 EQU * 02346000
MSG 810,AXSLINK AND WRITE THE MSG 02347000
B SETTRXIT AND EXIT 02348000
SPACE 02349000
SETTRE2 EQU * 02350000
MSG 811,AXSLINK AND WRITE MSG 02351000
SETTRXIT EQU * 02352000
L R14,CMDCMDSV RESTORE RETURN REG 02353000
BR R14 AND RETURN 02354000
EJECT 02355000
*---------------------------------------------------------------------* 02356000
* BACKSPAC AND FWDSPACE COMMANDS * 02357000
*---------------------------------------------------------------------* 02358000
*. 02359000
* RESPONSES - 02360000
* 02361000
* NONE 02362000
* 02363000
* ERROR MESSAGES - 02364000
* 02365000
* DMTNPT511E NO FILE ACTIVE ON LINK 'LINKID' 02366000
* 02367000
*. 02368000
SPACE 1 02369000
SETBACK EQU * 02370000
ST R14,CMDCMDSV SAVE RETURN REG 02371000
TM RDEVFLAG,FILACTIV IS THERE A FILE ACTIVE? 02372000
BNO SBKFWDN NO ERROR 02373000
CLI CMDRESP+3,BACKFILE BACKSPAC FILE? 02374000
BNE SETBACK1 NO CONTINUE 02375000
OI RDRCMD,RBACKFIL INDICATE CMD FOR RDR PROCESSING 02376000
B SBKFWDE AND EXIT 02377000
SPACE 02378000
SETBACK1 EQU * 02379000
OI RDRCMD,RBACKCNT MUST BE BACKSPAC COUNT 02380000
MVC RDRCMDCT(4),CMDRESP+12 SAVE COUNT FOR RDR 02381000
B SBKFWDE AND EXIT 02382000
SPACE 02383000
SETFWD EQU * 02384000
ST R14,CMDCMDSV SAVE RETURN REGISTER 02385000
TM RDEVFLAG,FILACTIV IS THERE A FILE ACTIVE? 02386000
BNO SBKFWDN NO ERROR 02387000
MVC RDRCMDCT(4),CMDRESP+12 SAVE COUNT FOR READER 02388000
OI RDRCMD,RFWDCNT INDICATE COMMAND FOR READER 02389000
B SBKFWDE AND EXIT 02390000
SPACE 02391000
SBKFWDN EQU * 02392000
MSG 511,AXSLINK WRITE NO FILE ACTIVE MSG 02393000
SBKFWDE EQU * 02394000
MVC RDRCMDLK(8),CMDRESP+4 MOVE IN RESPONSE LINKID 02395000
L R14,CMDCMDSV RESTORE RETURN REG 02396000
BR R14 AND RETURN 02397000
EJECT 02398000
*---------------------------------------------------------------------* 02399000
* FLUSH COMMAND * 02400000
*---------------------------------------------------------------------* 02401000
*. 02402000
* RESPONSES - 02403000
* 02404000
* NONE 02405000
* 02406000
* ERROR MESSAGES - 02407000
* 02408000
* DMTNPT581E FILE 'SPOOLID' NOT ACTIVE 02409000
* 02410000
*. 02411000
SPACE 1 02412000
SETFLUSH EQU * 02413000
ST R14,CMDCMDSV SAVE RETURN REG 02414000
MVC RDRCMDID(2),CMDRESP+12 SAVE FOR LATER COMPARE 02415000
LH R1,CMDRESP+12 GET SPOOLID 02416000
CVD R1,CMDCVD CONVERT TO DECIMAL 02417000
UNPK CMDFID,CMDCVD SPREAD THE DIGITS 02418000
OI CMDFID+3,X'F0' MAKE LAST PRINTABLE 02419000
TM RDEVFLAG,FILACTIV IS THERE A FILE ACTIVE? 02420000
BO SETFLSH1 YEP.. CONTINUE 02421000
MSG 581,CMDFID NO WRITE MSG 02422000
B SETFLSHE AND EXIT 02423000
SPACE 02424000
SETFLSH1 EQU * 02425000
CLI CMDRESP+3,FLUSHALL FLUSH ALL 02426000
BNE SETFLSH2 NO CONTINUE 02427000
OI RDRCMD,RFLSHALL SET RDRCMD BYTE 02428000
B SETFLSHE AND EXIT 02429000
SPACE 02430000
SETFLSH2 EQU * 02431000
CLI CMDRESP+3,FLUSHOLD FLUSH AND HOLD? 02432000
BNE SETFLSH3 NO MUST BE FLUSH COPY 02433000
OI RDRCMD,RFLSHOLD INDICATE CMD IN RDR CMD BYTE 02434000
B SETFLSHE AND EXIT 02435000
SPACE 02436000
SETFLSH3 EQU * 02437000
OI RDRCMD,RFLSHCPY INDICATE CMD IN RDR CMD BYTE 02438000
SETFLSHE EQU * 02439000
MVC RDRCMDLK(8),CMDRESP+4 MOVE IN RESPONSE LINKID 02440000
L R14,CMDCMDSV RESTORE RETURN REG 02441000
BR R14 AND RETURN 02442000
EJECT 02443000
*---------------------------------------------------------------------* 02444000
* CMD COMMANDS * 02445000
*---------------------------------------------------------------------* 02446000
*. 02447000
* RESPONSES - 02448000
* 02449000
* NONE 02450000
* 02451000
* ERROR MESSAGES - 02452000
* 02453000
* NONE 02454000
* 02455000
*. 02456000
SPACE 1 02457000
DS 0H 02458000
SETCMD EQU * 02459000
ST R14,CMDCMDSV SAVE RETURN 02460000
OC CMDRESP+12(8),FILL TO UPPR CASE 02461000
CLC CMDRESP+12(3),=C'LOG' LOGING REQUESTED? 02462000
BNE CMD2A NOPE 02463000
OI $LOGSW,LOGON SET LOGING REQUESTED 02464000
CMDNRET EQU * 02465000
L R14,CMDCMDSV RESTORE RETURN 02466000
BR R14 AND RETURN 02467000
SPACE 1 02468000
CMD2A EQU * 02469000
LA R14,CMDNRET SET RETURN ADDRESS @VA03520 02470000
CLC CMDRESP+12(5),=C'NOLOG' TURN OFF LOGING? 02471000
BE LOGCLOSE YES 02472000
BR R14 UNKNOWN REQUEST...IGNORE @VA03520 02473000
EJECT 02474000
*---------------------------------------------------------------------* 02475000
* * 02476000
* COMMAND DATA AREA * 02477000
* * 02478000
*---------------------------------------------------------------------* 02479000
SPACE 02480000
STRTCMD EQU X'80' START COMMAND 02481000
DRCMD EQU X'81' DRAIN COMMAND 02482000
FREECMD EQU X'82' FREE COMMAND 02483000
HOLDCMD EQU X'83' HOLD COMMAND 02484000
TRACECMD EQU X'84' TRACE COMMAND 02485000
BACKCMD EQU X'90' BACKSPAC COMMAND 02486000
FWDCMD EQU X'91' FORWARD SPACE COMMAND 02487000
FLUSHCMD EQU X'A0' FLUSH COMMAND 02488000
CMDCMD EQU X'B0' COMMAND COMMAND 02489000
MSGCMD EQU X'B1' MESSAGE COMMAND 02490000
SPACE 02491000
* COMMAND MODIFIERS 02492000
TRACEOFF EQU X'C0' TRACE OFF 02493000
TRACERR EQU X'80' ERROR TRACE ON 02494000
TRACEALL EQU X'00' TRACE ALL ON 02495000
BACKCNT EQU X'80' BACKSPAC COUNT 02496000
BACKFILE EQU X'00' BACKSPAC FILE 02497000
FLUSHCPY EQU X'00' FLUSH COPY 02498000
FLUSHALL EQU X'80' FLUSH ALL 02499000
FLUSHOLD EQU X'40' FLUSH HOLD 02500000
HOLDIMM EQU X'80' HOLD IMMEDIATE 02501000
STACLASS EQU X'80' START RESET CLASS 02502000
SPACE 02503000
CMDSETUP DC A(CMDTABLE) COMMAND TABLE ADDRESS 02504000
DC A(CMDINC) 02505000
DC A(CMDEND-CMDINC) LAST ENTRY 02506000
SPACE 1 02507000
CMDINC EQU 4 LENGTH OF COMMAND TABLE ENTRY 02508000
SPACE 02509000
CMDTABLE DC 0F'0' 02510000
DC AL1(STRTCMD),AL3(SETSTART) 02511000
DC AL1(DRCMD),AL3(SETDRAIN) 02512000
DC AL1(FREECMD),AL3(SETFREE) 02513000
DC AL1(HOLDCMD),AL3(SETHOLD) 02514000
DC AL1(TRACECMD),AL3(SETTRACE) 02515000
DC AL1(BACKCMD),AL3(SETBACK) 02516000
DC AL1(FWDCMD),AL3(SETFWD) 02517000
DC AL1(FLUSHCMD),AL3(SETFLUSH) 02518000
DC AL1(CMDCMD),AL3(SETCMD) 02519000
CMDEND EQU * 02520000
SPACE 02521000
CMDCVD DC D'0' CONVERT AREA 02522000
CMDFID DC CL4' ' COMMAND SPOOLID AREA 02523000
DC CL4' ' 02524000
CMDCMDSV DS F RETURN SAVE 02525000
EJECT 02526000
RDRCMD DC X'00' READER COMMAND BYTE 02527000
* BITS DEFINED IN RDRCMD 02528000
RBACKFIL EQU X'80' BACKSPACE FILE 02529000
RBACKCNT EQU X'40' BACKSPACE COUNT 02530000
RFWDCNT EQU X'20' FORWARD SPACE COUNT 02531000
RFLSHCPY EQU X'10' FLUSH COPY 02532000
RFLSHALL EQU X'08' FLUSH ALL COPIES 02533000
RFLSHOLD EQU X'04' FLUSH AND HOLD 02534000
RHLDIPGS EQU X'02' HOLD IN PROGRESS 02535000
SPACE 02536000
RDRCMDCT DC F'0' FILE SPACE COUNT 02537000
RDRCMDID DC H'0' CMD INDICATED SPOOLID 02538000
RDRCMDLK DC CL8' ' RESPONSE LINKID 02539000
HLDCMDLK DC CL8' ' RESPONSE LINKID 02540000
EJECT 02541000
*---------------------------------------------------------------------* 02542000
* * 02543000
* DEVICE TABLES * 02544000
* * 02545000
*---------------------------------------------------------------------* 02546000
SPACE 02547000
LINE DC F'0' SYNCH LOCK 02548000
DC XL2'0000' DEVICE ADDRESS TO BE FILLED IN 02549000
DC AL1(1),AL1(TYP2700) SENSE REQUEST, DEVICE TYPE CODE 02550000
DC A(0) CHANNEL PROGRAM START ADDRESS 02551000
DC 2F'0' RETURN SIO COND CODE AND ENDING CSW 02552000
DC X'00',AL1(0,0,0) RET SENSE INFO, DEVICE STATUS FLAGS 02553000
DC C'000',C'LINE ' EBCDIC ADDRESS AND TYPE 02554000
EJECT 02555000
*---------------------------------------------------------------------* 02556000
* * 02557000
* UNIT RECORD REQUEST BLOCKS * 02558000
* * 02559000
*---------------------------------------------------------------------* 02560000
SPACE 02561000
PUNBLK DC F'0' SYNCH LOCK 02562000
DC CL4'AXS ' TASKNAME TO FILE ACCESS 02563000
DC A(PUNREQ) REQUEST BUFFER 02564000
DC AL1(19),AL3(PUNREQ) RESPONSE BUFFER 02565000
PUNREQ DC AL1(19,0,0,0) LENGTH,FUNCTION,SPARE,SUBCODE 02566000
DC A(PUNTAG) TAG ADDRESS 02567000
DC A(0) I/O AREA ADDRESS 02568000
DC CL8' ' LINK ID 02569000
DC C'000',C'PUNCH' DEVICE STYLE 02570000
DC AL1(0,0,0,0) FLAG BYTES 02571000
SPACE 02572000
RDRBLK DC F'0' SYNCH LOCK 02573000
DC CL4'AXS ' TASKNAME TO FILE ACCESS 02574000
DC A(RDRREQ) REQUEST BUFFER 02575000
DC AL1(19),AL3(RDRREQ) RESPONSE BUFFER 02576000
RDRREQ DC AL1(0,0,0,0) LENGTH,FUNCTION,SPARE,SUBCODE 02577000
DC A(0) TAG ADDRESS 02578000
DC A(0) I/O AREA ADDRESS 02579000
DC CL8' ' LINK ID 02580000
DC C'000',C'SPRDR' DEVICE STYLE 02581000
DC AL1(FILREADY,0,0,0) FLAG BYTES 02582000
EJECT 02583000
*---------------------------------------------------------------------* 02584000
* * 02585000
* UNIT RECORD TAGS * 02586000
* * 02587000
*---------------------------------------------------------------------* 02588000
SPACE 02589000
PUNTAG DC 108CL1' ' PUNCH TAG 02590000
SPACE 02591000
EJECT 02592000
*---------------------------------------------------------------------* 02593000
* * 02594000
* CHANNEL PROGRAMS, PSW'S, CONSTANTS * 02595000
* * 02596000
*---------------------------------------------------------------------* 02597000
SPACE 02598000
READINIT CCW 2,INIT,SILI,4 INITIAL CONNECTION PROGRAM @VA03349 02599000
ENQPROG CCW 1,ENQBYTE,CC+SILI,ENQBYTEL @VA03349 02600000
CCW 2,RESP,SILI,2 @VA03349 02601000
TRANSMIT CCW 1,0,CC+SILI,0 WRITE DATA TO DEVICE @VA03349 02602000
CCW 3,ETBTRA,CC+SILI,2 02603000
CCW 2,RESP,SILI,2 @VA03349 02604000
RECEIVE CCW 1,SENDRESP+1,CC+SILI,SENDRESL-1 RECEIVE DATA @VA03349 02605000
* FROM DEVICE 02606000
RDONLYPG CCW 2,LINEINB,SILI,BUFFLEN 02607000
NAKPROG CCW 1,NAKBYTE,CC+SILI,NAKBYTEL @VA03349 02608000
CCW 2,LINEINB,SILI,BUFFLEN 02609000
EOTPROG CCW 1,EOTBYTE,SILI,EOTBYTEL @VA03349 02610000
DUMYREAD CCW 2,0,SILI+SKIP,1 TO RESET CHAR PHASE LATCH 02611000
NRDYPROG CCW 1,EOTBYTE,CC+SILI,EOTBYTEL @VA03349 02612000
CCW 2,LINEINB,SILI,BUFFLEN 02613000
SPACE 02614000
PUTPROG CCW 1,*-*,SILI,80 02615000
RVIPROG CCW 1,RVIBYTE,CC+SILI,6 REVERSE INTERRUPT @VA03349 02616000
CCW 2,LINEINB,SILI,2 @VA03349 02617000
SELPROG CCW 1,0,CC+SILI,0 @VA03349 02618000
CCW 2,RESP,SILI,2 @VA03349 02619000
SPACE 02620000
* 02621000
BUFFLEN EQU 520 MAXIMUM LINE BUFFER LENGTH @VA04617 02622000
XTRASYNS EQU 2 NUM EXTRA SYN CHARS @VA03349 02623000
TMTCNTR DC F'20' TIMEOUT COUNTER 02624000
EOTCNT DC F'5' EOT TIMEOUT COUNTER @VA03342 02625000
ENQBYTEL EQU 5 @VA03349 02626000
ENQBYTE DC AL1(SYN),(XTRASYNS)AL1(SYN),AL1(ENQ),AL1(EPAD) @VA04357 02627000
ETBTRA DC AL1(DLE,ETB) ENDING SEQUENCE 02628000
DCX DC XL3'021126' STX,DC1,ETB 02629000
INDEVSEL DC XL4'02276126' STX,ESC,/,ETB 02630000
PRTSEL DC AL1(DC1,IRS) DEFAULT IS 3770 CONSOLE PRINTER @VA04171 02630500
RVIBYTE DC AL1(SYN),(XTRASYNS)AL1(SYN),AL1(DLE,RVI) @VA03349 02631000
DC AL1(EPAD) @VA03349 02632000
NAKBYTEL EQU 5 @VA03349 02633000
NAKBYTE DC AL1(SYN),(XTRASYNS)AL1(SYN),AL1(NAK),AL1(EPAD) @VA04357 02634000
EOTBYTEL EQU 5 @VA03349 02635000
EOTBYTE DC AL1(SYN),(XTRASYNS)AL1(SYN),AL1(EOT),AL1(EPAD) @VA03349 02636000
SENDRESP DC XL6'000000000000' @VA03349 02637000
ORG SENDRESP @VA03349 02638000
SENDRESL EQU 6 @VA03349 02639000
DC AL1(SYN),(XTRASYNS)AL1(SYN) @VA04357 02640000
RESP DC XL2'0000' ACTUAL RESPONSE SENT OR @VA03349 02641000
* RECEIVED FOR TRANSMIT OR 02642000
* RECEIVE CHANNEL PROGRAMS 02643000
DC AL1(EPAD) @VA03349 02644000
EXPRESP DC XL2'0000' EXPECTED RESPONSE FROM DEVICE @VA03349 02645000
* FOR RECEIVE CHANNEL PROGRAM 02646000
INIT DC XL4'00000000' INITIAL CONNECTION RESPONSE @VA03349 02647000
* FROM DEVICE 02648000
INITACK0 DC XL2'1070' INITIAL ACK RESPONSE TO DEVICE @VA03349 02649000
NAKCOUNT DC F'0' SUCCESSIVE NAK RETRY COUNT @VA03349 02650000
RETRYNAK DC H'3' SUCCESSIVE NAK RETRY LIMIT @VA03349 02651000
WACK DC AL1(DLE,WABT) TEMPORARY DELAY @VA03349 02652000
SIGNOFF DC C'/*SIGNOFF' SIGNOFF CARD IMAGE @VA08251 02652100
EJECT 02653000
SPACE 02654000
* CARRIAGE CONTROL CHARACTERS TRANSLATION TABLE FOR NON-2780 02655000
CCTAB DC CL16'M/ST////////////' 02656000
DC CL16'/ABCDEFGHIJKL///' 02657000
SPACE 1 02658000
* CARRIAGE CONTROL CHARACTERS TRANSLATION TABLE FOR 2780 02659000
CCT2780 DC CL16'//ST////////////' @VA03488 02660000
DC CL16'/ABCDEFGH///////' @VA03488 02661000
SPACE 1 02662000
PREVOP DC X'00' PREVIOUS CCW CC CODE @VA03488 02663000
PREVOPS DC X'00' MODIFIED PREVIOUS CCW CC CODE @VA03488 02664000
SPACE 02665000
BLANK DC CL2' ' 02666000
MAXPRINT DC 1H'0' MAX. NUMBER OF PRINT POSITIONS @VA03426 02667000
MAXREC DC 1H'0' MAX NUMBER OF RECORD IN A BLOCK 02668000
MAXREC1 DC 1H'0' MAX NUMBER OF RECORD IN A BLOCK 02669000
MAXBYTS DC 1H'0' MAX NUMBER OF BYTES IN A BLOCK 02670000
SPACE 02671000
* RECORDS SEPARATOR CHARACTERS 02672000
SPACE 02673000
TAB DC 64F'0' 02674000
ORG TAB+X'03' 02675000
DC X'03' ETX 02676000
ORG TAB+X'1E' 02677000
DC X'1E' IRS 02678000
ORG TAB+X'1F' 02679000
DC X'1F' ITB 02680000
ORG TAB+X'26' 02681000
DC X'26' ETB 02682000
ORG TAB+256 02683000
SPACE 4 02684000
LTORG 02685000
SPACE 4 02686000
********************0123456789ABCDEF**** 02687000
TRPRTB DC 64X'4B' 0-3 02688000
DC CL16' .........¢.<(+|' 4 02689000
DC CL16'&&.........!$*);¬' 5 02690000
DC CL16'-/.........,%_>?' 6 02691000
DC CL16'..........:#@''="' 7 02692000
DC CL16'.ABCDEFGHI......' 8 02693000
DC CL16'.JKLMNOPQR......' 9 02694000
DC CL16'..STUVWXYZ......' A 02695000
DC CL16'................' B 02696000
DC CL16'.ABCDEFGHI......' C 02697000
DC CL16'.JKLMNOPQR......' D 02698000
DC CL16'..STUVWXYZ......' E 02699000
DC CL16'0123456789......' F 02700000
********************0123456789ABCDEF**** 02701000
* 02702000
EJECT 02703000
*---------------------------------------------------------------------* 02704000
* * 02705000
* SAVE AREAS & BUFFERS * 02706000
* * 02707000
*---------------------------------------------------------------------* 02708000
SPACE 02709000
GETSAVE DS 3F GETBLOCK SAVE AREA 02710000
CMDSAVE DS 6F COMMANDS SAVE AREA 02711000
SPACE 02712000
STARTLIN DC A(0) START OF LINE 02713000
BYTSCNT DC 1H'0' NUM OF BYTES IN BUFFER 02714000
RECNT DC 1H'0' NUM OF RECORDS IN BUFFER 02715000
LINEBUFF DS A LINE OUTPUT BUFFER 02716000
SPACE 02717000
LINEINB DS (BUFFLEN)C LINE INPUT BUFFER 02718000
SPACE 02719000
BUFSTART DC AL4(BUFUNPK) BUFUNPK POINTER 02720000
BUFCNT DC 1H'0' BYTES COUNT 02721000
BUFUNPK DS 134C UNPACK BUFFER 02722000
OUTCARD DS 80C OUTPUT BUFFER FOR BLKCOMP 02723000
DC AL1(ETX,EOT) END-OF-BUFFER DELIMITER @VA03112 02724000
SELBUF DC F'0' SELECTION BUFFER @VA03349 02725000
EJECT 02726000
*. 02727000
* 02728000
* ENTRY NAME - 02729000
* 02730000
* MSGPROC 02731000
* 02732000
* FUNCTION - 02733000
* 02734000
* THIS ROUTINE WILL UNSTACK MSGS FROM THE TASK MSG QUEUE 02735000
* AND TRANSMIT THEM TO THE REMOTE TERMINAL PRINTER. 02736000
* 02737000
* CALLS TO OTHER ROUTINES - 02738000
* 02739000
* GMSGREQ - TO UNSTACK MESSAGES 02740000
* 02741000
* OPERATION - 02742000
* 02743000
* 1. SEND ENQ AND WAIT FOR CORRECT RESPONSE 02744000
* 02745000
* 2. DEQUEUE MSG VIA CALL TO GMSGREQ 02746000
* 02747000
* 3. TRANSMIT THE MSG BUFFER AND WAIT FOR CORRECT 02748000
* RESPONSE. 02749000
* 02750000
* 4. RETURN TO 2. UNTIL NO MORE MESSAGES ARE QUEUED,THEN 02751000
* SEND EOT. 02752000
* 02753000
* 02754000
* RESPONSES - 02755000
* 02756000
* NONE 02757000
* 02758000
* ERROR MESSAGES - 02759000
* 02760000
* NONE 02761000
* 02762000
*. 02763000
SPACE 1 02764000
MSGPROC EQU * 02765000
ST R14,MSGPSAVE SAVE RETURN REGISTER 02766000
LA R15,RETRYNUM SET REPLY COUNT 02767000
MSGSRTRY EQU * 02768000
MVC DEVSTART(4),=A(ENQPROG) SET ENQUIRY PROGRAM 02769000
BAL R14,LINEIO SEND ENQ AND LISTEN 02770000
TM DEVFLAGS,IOERR ANY ERROR? 02771000
BNO MSGSCK NO - GO TO CHECK THE RESPONSE 02772000
TM DEVCSW+4,UC UNIT CHECK? 02773000
BNO MSGSEOT NO UNIT EXCEPTION SEND EOT AND RETRY 02774000
BCTR R15,0 UPDATE TIMEOUT COUNT 02775000
LTR R15,R15 END OF RETRY? 02776000
BP MSGSRTRY NO - TRY AGAIN 02777000
SPACE 02778000
MSGSEOT EQU * 02779000
BAL R14,SENDEOT GO TO SEND EOT 02780000
LA R15,RETRYNUM RESET ERROR COUNTER 02781000
B MSGSRTRY AND RETRY ONCE MORE 02783000
SPACE 02784000
MSGSCK EQU * 02785000
CLC RESP(2),EXPRESP CORRECT RESPONSE @VA03349 02786000
BE MSGSSLCT YES - GO TO SELECT THE UNIT 02787000
CLI RESP,EOT BACK TO CNTL MODE @VA03349 02788000
BE MSGSEOT YES - GO TO RESET AND RETRY 02789000
TM INTFLAG,SIGNONED SIGNONED YET? 02790000
BNO MSGSRTRY NO..NOT READY FOR ENQ 02791000
CLI RESP,ENQ IS HE TRYING TO TALK @VA03349 02792000
BE NPTACK0 YES..COME BACK LATER 02793000
CLI RESP,NAK IS IT DEVICE NOT READY @VA03862 02793200
BNE MSGSRTRY NO, JUST RETRY @VA03862 02793400
LA R0,2 TAKE A TWO SECOND DELAY @VA03862 02793600
BAL R14,TDELAY @VA03862 02793800
B MSGSRTRY NO - RETRY 02794000
SPACE 02795000
MSGSSLCT EQU * 02796000
XC MSGLAST(4),MSGLAST CLEAR LAST MESSAGE NUMBER @VA03743 02797000
XI EXPRESP+1,X'11' SWITCH THE EXPECTED RESPONSE @VA03349 02798000
L R3,LINEBUFF GET BUFFER ADDR 02799000
MVI 0(R3),STX PREPARE FIRST CHAR. 02800000
LA R3,1(R3) SET BUFFER POINTER 02801000
LA R5,1 AND BYTES COUNT 02802000
MSGCONT EQU * 02803000
TM INTFLAG,WSEM SERIOUS SIGNON ERROR @VA03349 02804000
BZ MSGCONTA NO, CONTINUE @VA04171 02805200
TM DEVFEAT,REM3770 IS A 3770 DEFINED @VA04171 02805400
BO MSGCONTB YES, MUST SELECT SOMETHING @VA04171 02805600
MSGCONTA EQU * @VA04171 02805800
TM DEVFEAT,REM2780 IS THE REMOTE STATION A 2780? 02806000
BO MSG2780 YES - SKIP NEXT CODE 02807000
TM DEVFEAT,REMPUNCH PUNCH UNIT INSTALLED @VA03742 02808000
BNO MSG2780 NO...DONT SELECT @VA03742 02809000
MSGCONTB EQU * @VA04171 02809500
TM DEVFEAT,REM3770 IS IT A 3770 @VA03349 02810000
BZ MSG2770 NO, SELECT NORMAL @VA03349 02811000
MVC 0(2,R3),PRTSEL SELECT THE SPECIFIED 3770 PRINTER@VA04171 02812500
B MSG2770A @VA03349 02813000
MSG2770 MVC 0(2,R3),=AL1(DC1,IRS) SELECT 2770 PRINTER @VA03349 02814000
MSG2770A EQU * @VA03349 02815000
LA R3,2(R3) UPDATE BUFFER POINTER 02816000
LA R5,2(R5) AND BYTES COUNT 02817000
MSG2780 EQU * 02818000
MVI MSGTEXT,C' ' SETUP TO CLEAR MSGTEXT @VA03743 02819000
MVC MSGTEXT+1(109),MSGTEXT CLEAR MSGTEXT @VA03743 02820000
LA R1,MSGPREFX GET THE MSG BUFFER ADDR @VA03279 02821000
L R2,NPTALINK GET MY LINKID ADDR 02822000
L R15,TCOM GET COMMON ROUTINE TABLE ADDR 02823000
L R15,GMSGREQ GET MSG UNSTACK ROUTINE ADDR 02824000
BALR R14,R15 AND TRY TO GET A MSG 02825000
LTR R15,R15 ANY LEFT? 02826000
BNZ MSGEOT NO ALL DONE 02827000
CLC MSGTEXT+8(3),MSGLAST IS THIS THE SAME MESSAGE @VA03743 02828000
BNE MSGDO NO SEND THE MESSAGE @VA03743 02829000
CLC MSGTEXT+8(3),=CL3'201' INVALID COMMAND? @VA03743 02830000
BE MSG2780 YES ALREADY SENT FLUSH IT @VA03743 02831000
MSGDO EQU * SENT THE MESSAGE TO TERMINAL @VA03743 02832000
MVC MSGLAST(3),MSGTEXT+8 SAVE FOR LATER COMPARE @VA03743 02833000
MVC MSGTEXT(2),MSGRESET RESET HEADER 02834000
LA R4,MSGBLEN GET MESSAGE BUFFER ADDR 02835000
AR R5,R4 IN REG.2 BUFFER BYTES COUNT 02836000
BCTR R4,0 -1 FOR EXEC 02837000
EX R4,MVCMSG MOVE MSG. 02838000
STH R5,TRANSMIT+6 SET BYTE COUNT @VA03349 02839000
MSGDOA EQU * @VA04171 02839500
MVC DEVSTART,=A(TRANSMIT) PROG TO SEND TO DEVICE @VA03349 02840000
BAL R14,LINEIO GO DO THE IO @VA03349 02841000
BAL R8,SENDVRFY CHECK THE OPERATION @VA03349 02842000
TM RESTRSEQ,X'80' RESTORE SEQUENCE? @VA11230 02842100
BO MSGEOTC YES,AVOID RESTR LOOP @VA11230 02842200
SPACE 02843000
MSGNEXT EQU * 02844000
L R3,LINEBUFF GET LINE BUFFER ADDR 02845000
MVI 0(R3),STX MOVE IN HEADER 02846000
LA R3,1(R3) UP BY ONE 02847000
LA R5,1 INDICATE ONE BYTE SO FAR 02848000
B MSGCONT AND CONTINUE 02849000
SPACE 02850000
MSGEOT EQU * 02851000
OI RESTRSEQ,X'80' INDICATE RESTORE SEQ @VA11230 02851010
TM DEVFEAT,REM2770 IS IT A 2770 TYPE @VA04171 02851100
BO MSGEOTA YES @VA04171 02851150
MVC 0(4,R3),MSGREST SET UP THE RESTORE @VA04171 02851200
LA R5,4(0,R5) @VA04171 02851250
B MSGEOTB @VA04171 02851300
MSGEOTA MVC 0(5,R3),MSGRESTA SET UP RESTORE FOR 2770 @VA04171 02851350
LA R5,5(0,R5) GET END OF RESTORE @VA04171 02851400
MSGEOTB STH R5,TRANSMIT+6 @VA04171 02851450
MVC DEVSTART,=A(TRANSMIT) @VA04171 02851500
BAL R14,LINEIO GO DO THE RESTORE @VA04171 02851550
BAL R8,SENDVRFY CHECK THE OPERATION @VA04171 02851600
MSGEOTC EQU * @VA11230 02851610
XC RESTRSEQ,RESTRSEQ RESET RSTR BEFORE EOT @VA11230 02851620
BAL R14,SENDEOT SEND EOT 02852000
NI GETFLAGS,255-MSGQUED TURN OFF MSGS QUEUED FLAG 02853000
L R14,MSGPSAVE RESTORE RETURN REGISTER 02854000
BR R14 AND RETURN 02855000
SPACE 1 02856000
MVCMSG MVC 0(*-*,R3),MSGTEXT TO BE EXECUTED FROM ABOVE @VA03349 02857000
SPACE 3 02858000
MSGPSAVE DS F SAVE FOR RETURN REGISTER 02859000
RESTRSEQ DC X'00' RESTORE INDIDCATOR @VA11230 02859100
SPACE 1 02860000
MSGRESET DC AL1(ESC),CL1'/' RESET NEARER @VA04949 02861000
SPACE 1 02862000
MSGPREFX DC CL8' ' LOCID @VA03279 02863000
MSGTEXT DC AL1(ESC),CL1'/' BSC ESCAPE SEQUENCE @VA04949 02864000
DC 110C' ' MSG TEXT 02865000
DC AL1(NL) FORCE EXECUTION OF ESC SEQUENCE @VA04949 02865100
DC AL1(ETX) END OF LINE BUFFER 02866000
MSGBLEN EQU *-MSGTEXT LENGTH OF MSG BUFFER 02867000
SPACE 02868000
MSGLAST DC F'0' HOLD AREA FOR MESSAGE NUMBER @VA03743 02869000
MSGREST DC AL1(ESC),CL1'A',CL1' ',AL1(ETX) @VA04171 02869300
MSGRESTA DC AL1(ESC),CL1'A',CL1' ',AL1(IRS,ETX) @VA04171 02869600
EJECT 02870000
*. 02871000
* 02872000
* ENTRY NAME - 02873000
* 02874000
* MSG 02875000
* 02876000
* FUNCTION - 02877000
* 02878000
* THIS ROUTINE PREPARES AND SENDS REQUESTS TO THE 02879000
* SPECIALIZED TASK REX, IN ORDER TO WRITE MESSAGES 02880000
* ON THE OPERATOR'S CONSOLE. 02881000
* 02882000
* CALLS TO OTHER ROUTINES - 02883000
* 02884000
* DMTREX - TO EXECUTE THE MSG WRITE 02885000
* 02886000
* OPERATION - 02887000
* 02888000
* 1. MOVE VARIABLE PART OF MSG TO GIVE REQUEST BUFFER. 02889000
* 02890000
* 2. INITIATE GIVE REQUEST TO DMTREX WITH THE MSG BUFFER. 02891000
* 02892000
* 3. WAIT FOR COMPLETION. 02893000
* 02894000
* 4. RETURN TO CALLER. 02895000
* 02896000
* ENTRY CONDITIONS: 02897000
* 02898000
* IN REG. 14 THE RETURN ADDRESS 02899000
* IN REG. 15 THE ROUTING CODE 02900000
* IN REG. 1 THE POINTER TO THE VARIABLE PORTION OF 02901000
* THE MESSAGE STRING 02902000
* IN REG. 0 THE LENGTH OF THE VARIABLE PORTION OF THE MSG 02903000
* 02904000
* EXIT CONDITIONS: 02905000
* 02906000
* NONE 02907000
* 02908000
* RESPONSES - 02909000
* 02910000
* NONE 02911000
* 02912000
* ERROR MESSAGES - 02913000
* 02914000
* NONE 02915000
* 02916000
*. 02917000
EJECT 02918000
MSG DC 0H'0' 02919000
STM R14,R2,MSGSAVE SAVE REGISTERS 02920000
LR R2,R0 MOVE R0 INTO WORK REG 02921000
BCTR R2,0 REDUCE BY ONE FOR MVC 02922000
EX R2,MSGMVC AND MOVE TO MSG REQ BUFFER 02923000
LA R2,24(R2) AND INCLUDE HEADER IN COUNT 02924000
STC R2,MSGBLK AND STORE IN MSG REQ BUFFER 02925000
CLI MSGLINK,X'00' SOMEONE SET THE LINKID? 02926000
BNE MSG1 YES CONTINUE 02927000
MVC MSGLINK(8),AXSLINK USE MY LINKID 02928000
MSG1 EQU * 02929000
LA R1,MSGREQ GET READY FOR GIVE 02930000
XC MSGREQ(4),MSGREQ CLEAR OUT SYNCH LOCK 02931000
L R15,GIVEREQ SYSTEM GIVE REQUEST EXECUTATOR 02932000
BALR R14,R15 GO GIVE THE BUFFER TO REX 02933000
L R15,WAITREQ WAIT FOR THE COMPLETION OF 02934000
BALR R14,R15 CONSOLE OPERATION 02935000
MVI MSGLINK,X'00' SET NO RESPONSE LINKID 02936000
MVI MSGBLK+2,X'00' ZERO ROUTING CODE 02937000
LM R14,R2,MSGSAVE RESTORE REGS 02938000
BR R14 AND RETURN 02939000
SPACE 02940000
MSGMVC MVC MSGBUF(0),0(R1) TO BE EXECUTED FROM ABOVE 02941000
SPACE 02942000
DS 0F 02943000
MSGREQ DC F'0' SYNCH LOCK 02944000
DC CL4'REX ' TASK NAME 02945000
DC A(MSGBLK) GIVE REQUEST BUFFER 02946000
DC A(0) NO RESPONSE BUFFER 02947000
SPACE 1 02948000
MSGBLK DC AL1(0),AL1(2),AL1(0),AL1(0) 02949000
MSGLINK DC 8X'00' LINKID 02950000
MSGVMID DC CL8' ' VIRTUAL MACHINE ID 02951000
DC CL3'NPT',CL1' ' MODULE ID PLUS ACTION CODE 02952000
MSGBUF DC CL120' ' MSG BUFFER 02953000
SPACE 02954000
MSGSAVE DC 5F'0' SAVE AREA 02955000
EJECT 02956000
*. 02957000
* 02958000
* ENTRY NAME - 02959000
* 02960000
* HEADPREP 02961000
* 02962000
* FUNCTION - 02963000
* 02964000
* THIS ROUTINE PROVIDES, ONE RECORD AFTER THE OTHER, 02965000
* THE SEPARATOR AND THE HEADER FOR THE PRINT TYPE FILES 02966000
* AND THE HEADER CARD FOR THE PUNCH TYPE FILES. 02967000
* 02968000
* CALLS TO OTHER ROUTINES - 02969000
* 02970000
* NONE 02971000
* 02972000
* OPERATION - 02973000
* 02974000
* 1. GET NEXT ENTRY FROM HEADER TABLE AND PLACE IN THE OUTPUT 02975000
* BUFFER. 02976000
* 02977000
* 2. UPDATE HEADER TABLE TO NEXT ENTRY. 02978000
* 02979000
* 3. IF AT END OF TABLE RESET TABLE AND HEADFLAG. 02980000
* 02981000
* ENTRY CONDITIONS: 02982000
* 02983000
* IN REG. 14 THE RETURN ADDRESS. 02984000
* 02985000
* EXIT CONDITIONS: 02986000
* 02987000
* THE INTERMEDIATE BUFFER BUFUNPK, CONTAINS THE ACTUAL 02988000
* SEPARATOR OR HEADER RECORD. 02989000
EJECT 02990000
* 02991000
* NOTE: 02992000
* 02993000
* THE SEPARATOR FOR THE PRINT TYPE FILES IS AS FOLLOWS: 02994000
* 02995000
* PAGE EJECT 02996000
* SKIP 61 LINES 02997000
* 5 LINES OF 130 ASTERISKS 02998000
* 1 LINE OF 130 UNDERLINES 02999000
* 5 LINES OF 130 ASTERISKS 03000000
* 2 BLANK LINES 03001000
* 03002000
* THE HEADER FOR BOTH THE PRINT AND PUNCH TYPE FILES, 03003000
* IS AS FOLLOWS: 03004000
* 03005000
* 1- 8 FILE ORIGIN LOCATION 03006000
* 13-20 FILE ORIGIN VIRTUAL MACHINE 03007000
* 25-32 FILE ORIGIN DATE 03008000
* 37-44 FILE ORIGIN TIME 03009000
* 55-68 WAS THE ORIGIN 03011000
* 03012000
* 03013000
* RESPONSES - 03014000
* 03015000
* NONE 03016000
* 03017000
* ERROR MESSAGES - 03018000
* 03019000
* NONE 03020000
* 03021000
*. 03022000
EJECT 03023000
HEADPREP EQU * 03024000
STM R13,R15,HDPRSAVE SAVE CALLER REGISTERS 03025000
TM GETFLAGS,PRNTSEND PRINT FILE? 03026000
BZ HEADLINE NO - ONLY HEADER CARD 03027000
* 03028000
L R13,HEADPNT LOAD THE HEADER POINTER 03029000
L R14,0(R13) GET THE ADDRESS 03030000
BR R14 AND GO TO EXEC IT 03031000
SPACE 2 03032000
SKIPCH1 EQU * 03033000
TM GETFLAGS,EJECT WAS LAST OP TO PRINTER A PRINT @VA03640 03034000
* FILE (I.E., NOT A MESSAGE) 03035000
BO NOSKIP1 YES, DON'T DO ANOTHER EJECT @VA03640 03036000
MVC BUFUNPK(2),=X'8840' SKIP TO CHA. 1 03037000
B HEADRET0 AND GO TO EXIT 03038000
SPACE 03039000
NOSKIP1 EQU * @VA03640 03040000
NI GETFLAGS,X'FF'-EJECT RESET LAST-OP-WAS-PRINT @VA03640 03041000
LA R13,4(,R13) POINT TO NEXT ENTRY IN TABLE @VA03640 03042000
ST R13,HEADPNT SAVE POINTER @VA03640 03043000
SPACE 1 03044000
SKIP3 EQU * 03045000
MVC BUFUNPK(2),=X'1940' SKIP 3 03046000
B HEADRET0 AND GO TO EXIT 03047000
SPACE 03048000
DOUBSP EQU * 03049000
MVC BUFUNPK(2),=X'1340' DOUBLE SPACE 03050000
HEADRET0 EQU * 03051000
OI GETFLAGS,IMCMD SHOW IMMED COMMAND 03052000
LA R15,2 BYTES COUNT 03053000
B HEADRET AND RETURN 03054000
SPACE 03055000
ASTER EQU * 03056000
MVI BUFUNPK+1,X'5C' * 03057000
B ASTUND AND CONTINUE 03058000
UNDERLIN EQU * 03059000
MVI BUFUNPK+1,X'6D' _ 03060000
SPACE 03061000
ASTUND EQU * 03062000
MVI BUFUNPK,X'09' PRINT AND SPACE 1 03063000
MVC BUFUNPK+2(129),BUFUNPK+1 ***** OR ______ 03064000
LA R15,131 SET LENGTH 03065000
B HEADRET AND RETURN 03066000
SPACE 03067000
HEAD2LIN EQU * 03068000
LA R14,HDRLINE2 GET ADDR OF SECOND LINE 03069000
LA R15,LHDRLIN2 AND THE LENGTH 03070000
B HEADCONT AND CONTINUE 03071000
SPACE 03072000
HEADLINE EQU * 03073000
LA R14,HDRLINE GET ADDR OF HEADER LINE 03074000
LA R15,HDRLEN HEADER LENGTH 03075000
HEADCONT EQU * 03076000
BCTR R15,0 MINUS 1 03077000
EX R15,MVCHEAD MOVE THE LINE 03078000
LA R15,1(R15) RESTORE THE BYTES COUNT 03079000
EJECT 03080000
HEADRET EQU * 03081000
TM GETFLAGS,PRNTSEND PRINT FILE? 03082000
BZ HEADRST NO - EXIT 03083000
CLC HEADCRNT(1),0(R13) DONE THIS TYPE? 03084000
BE HEADNEXT YES CONTINUE 03085000
SR R14,R14 PREPARE FOR IC 03086000
IC R14,HEADCRNT GET CURRENT CNT 03087000
LA R14,1(R14) UP BY ONE 03088000
STC R14,HEADCRNT AND SAVE FOR LATER 03089000
B HEADRET1 AND CONTINUE 03090000
SPACE 1 03091000
HEADNEXT EQU * 03092000
MVI HEADCRNT,X'01' INDICATE 0 COUNT 03093000
LA R13,4(,R13) UPDATE POINTER FOR TABLE 03094000
CLI 0(R13),X'FF' END OF TABLE? 03095000
BNE HEADRET1 NO CONTINUE 03096000
HEADRST EQU * 03097000
LA R13,HEADTABL RESET TABLE POINTER 03098000
NI NPTFLAGS,X'FF'-HEADFLAG RESET HEADER FLAG 03099000
SPACE 03100000
HEADRET1 EQU * 03101000
ST R13,HEADPNT SAVE POINTER 03102000
STH R15,BUFCNT SAVE BYTES COUNT 03103000
MVC BUFSTART(4),=A(BUFUNPK) INDICATE START 03104000
NI GETFLAGS,X'FF'-BUFEMPTY SIGNAL BUFFER FULL 03105000
LM R13,R15,HDPRSAVE RESTORE CALLER REGISTERS 03106000
BR R14 AND RETURN 03107000
SPACE 3 03108000
MVCHEAD MVC BUFUNPK(*-*),0(R14) TO BE EXECUTED FROM ABOVE 03109000
SPACE 03110000
HDPRSAVE DS 3F SAVE AREA 03111000
HEADPNT DC AL4(HEADTABL) CURRENT POSITION IN HDR TABLE 03112000
HEADCRNT DC X'01' CURRENT NUM OF THIS TYPE 03113000
SPACE 03114000
HEADTABL DS 0F 03115000
DC AL1(1),AL3(SKIPCH1) SKIP TO CH. 1 03116000
DC AL1(16),AL3(SKIP3) SKIP THREE LINES 03117000
DC AL1(5),AL3(DOUBSP) SKIP TWO LINES 03118000
DC AL1(5),AL3(ASTER) 130 * 03119000
DC AL1(1),AL3(UNDERLIN) 130 _ 03120000
DC AL1(5),AL3(ASTER) 130 * 03121000
DC AL1(1),AL3(DOUBSP) DOUBLE SPACE 03122000
DC AL1(1),AL3(HEADLINE) HEADER LINE 03123000
DC AL1(1),AL3(HEAD2LIN) HEADER LINE 03124000
DC XL4'FFFFFFFF' END OF TABLE 03125000
EJECT 03126000
*. 03127000
* 03128000
* ENTRY NAME - 03129000
* 03130000
* MAKEBLOC 03131000
* 03132000
* FUNCTION - 03133000
* 03134000
* TO SETUP FOR A CALL TO VMSB2CP 03135000
* 03136000
* CALLS TO OTHER ROUTINES - 03137000
* 03138000
* NONE 03139000
* 03140000
* OPERATION - 03141000
* 03142000
* 1. SAVE CALLERS REGISTERS FOR VMSB2CP. 03143000
* 03144000
* 2. UPON RETURN FROM VMSP2CP SET RETURN CODE AND RETURN 03145000
* TO ORIGINAL CALLER. 03146000
* 03147000
* 03148000
* RESPONSES - 03149000
* 03150000
* NONE 03151000
* 03152000
* ERROR MESSAGES - 03153000
* 03154000
* NONE 03155000
* 03156000
*. 03157000
SPACE 03158000
MAKEBLOC DS 0H 03159000
* 03160000
* SAVE CALLER'S REGS 03161000
STM R0,R15,MAKESAVE 03162000
* 03163000
B VMSB2CP AND CONVERT VM BLOCK TO CP BLOCK 03164000
SPACE 03165000
MAKERET EQU * 03166000
LA R15,4 SIGNAL END OF FILE 03167000
B MAKEXT3 AND CONTINUE 03168000
EJECT 03169000
MAKERETX EQU * 03170000
SR R15,R15 CLEAR CON. CODE 03171000
MAKERET1 EQU * 03172000
ST R4,BUFSTART STORE THE STARTING POINT 03173000
LA R3,1(R3) UPDATE TO INCLUDE CC 03174000
STH R3,BUFCNT AND THE BYTES COUNT 03175000
MAKEXT3 EQU * 03176000
LM R0,R14,MAKESAVE RESTORE REGISTERS 03177000
LTR R15,R15 SET RETURN CODE 03178000
BR R14 03179000
* 03180000
MAKEMVC MVC 1(0,R4),0(R1) FROM PACKED LINE TO SPOOL 03181000
MAKESAVE DS 16F SAVE AREA 03182000
VMSBR1 DS F SAVE AREA 03183000
EJECT 03184000
*. 03185000
* 03186000
* ENTRY NAME - 03187000
* 03188000
* VMSB2CP 03189000
* 03190000
* FUNCTION - 03191000
* 03192000
* THIS ROUTINE DEBLOCKS THE VM/370 SPOOL PAGE BUFFERS INTO 03193000
* AN UNPACKED BUFFER (PACKBLK). 03194000
* 03195000
* CALLS TO OTHER ROUTINES - 03196000
* 03197000
* DMKHVC - TO READ A VM/370 SPOOL PAGE BUFFER 03198000
* 03199000
* OPERATION - 03200000
* 03201000
* 03202000
* 1. IF NEEDED READ THE NEXT PAGE BUFFER FROM VM. 03203000
* 03204000
* 2. CONSTRUCT THE RECORD FROM THE CCW DATA IN THE SPOOL 03205000
* PAGE BUFFER. 03206000
* 03207000
* 3. MOVE IN THE CARRIAGE CONTROL BYTE FROM THE CCW 03208000
* 03209000
* 4. SET IMMED FLAG IF IMMEDIATE COMMAND. 03210000
* 03211000
* 5. EXIT TO CALLER. 03212000
* 03213000
* 03214000
* RESPONSES - 03215000
* 03216000
* NONE 03217000
* 03218000
* ERROR MESSAGES - 03219000
* 03220000
* NONE 03221000
* 03222000
*. 03223000
SPACE 3 03224000
* REGISTERS 03225000
* 03226000
* GPR.1 INPUT AREA FOR PACK 03227000
* GPR.2 OUTPUT AREA FOR PACK 03228000
* GPR.3 INPUT LENGTH FOR PACK 03229000
* GPR.4 FIRST FREE BYTE IN OUTPUT BUFFER 03230000
* GPR.6 ANCHOR CCW IN VM SPOOL BLOCK 03231000
* GPR.7 NEXT CCW IN VM SPOOL BLOCK 03232000
* GPR.8 COUNT OF NON-TIC CCWS LEFT IN VM SPOOL BUFFER 03233000
EJECT 03234000
VMSB2CP DS 0H 03235000
* 03236000
* SETUP SPOOL BLOCK POINTERS 03237000
* 03238000
USING SPLINK,R1 GET PAGE SPOOL BUFFER ADDR 03239000
LA R4,BUFUNPK IS ADDRESS OF FIRST FREE BYTE 03240000
MVI BUFUNPK,C' ' CLEAR FIRST BYTE OF BUFFER @VM01140 03241000
MVC BUFUNPK+1(133),BUFUNPK AND THE REST OF THE BUFFE@VM01140 03242000
L R1,RDEVFIOA GET FILE I/O AREA ADDRESS 03243000
ST R1,VMSBR1 SAVE R1 FOR LATER 03244000
* 03245000
* CHECK FOR VM SPOOL BLOCK PRESENT 03246000
* 03247000
TM GETFLAGS,FILLED IS THE BUFFER ALREADY FILLED 03248000
BO VMSPBIN IF THE VM SPOOL BLOCK IS IN. 03249000
* 03250000
* READ A VM SPOOL BLOCK. 03251000
* 03252000
VMSPGET EQU * 03253000
* 03254000
L R1,VMSBR1 RESTORE R1 03255000
LA R2,RDRBLK GET READER DEVICE BLK ADDR 03256000
L R2,RDEVTAG GET READER TAG ADDRESS 03257000
LH R2,TAGDEV-TAG(R2) GET READER ADDRESS 03258000
SR R3,R3 TO INDICATE READ OF NEXT SPOOL BLOCK RECORD AND 03259000
DIAG R1,R2,X'14' COMMAND TO SPOOL READER 03260000
* 03261000
BC 8,VMSPOK IF THE READ IS SUCCESSFUL. 03262000
* 03263000
BC 4,MAKERET IF END OF FILE. 03264000
BC 2,MAKERET IF NO MORE FILES. 03265000
* 03266000
* ERROR ON SPOOL READ, GPR3 WILL CONTAIN.. 03267000
* 4 INVALID SPOOL READER ADDRESS 03268000
* 8 INVALID DEVICE 03269000
* 12 DEVICE BUSY WITH SIO I/O 03270000
* 16 PAGING I/O ERROR IN SETTING UP BUFFER. 03271000
* 03272000
MSG 108,RDEVFID WRITE ERROR MSG @VM01142 03273000
SPACE 1 @VM01142 03274000
B MAKERET AND IGNORE FOR PRESENT. 03275000
EJECT 03276000
VMSPOK EQU * HERE ON SUCCESSFUL READ 03277000
L R8,SPRECNUM PICKUP SPRECNUM FROM NEW BLOCK. 03278000
LTR R8,R8 ALL DONE IF ZERO 03279000
BZ VMSPGET TO GET THE NEXT SPOOL BLOCK. 03280000
LA R6,SPRECNUM+4 STEP OVER POINTERS IN SPOOL BLOCK 03281000
LR R7,R6 AND INITIALIZE WORKING REGS. 03282000
OI GETFLAGS,FILLED TO INDICATE BLOCK PRESENT 03283000
B VMSPCCW TO PROCESS NEXT CCW CHAIN. 03284000
DROP R1 DROP SPOOL BUFFER ADDR 03285000
* 03286000
* BUFFER IS PRESENT ON ENTRY TO VMSB2CP. 03287000
* 03288000
VMSPBIN EQU * 03289000
L R6,VMSPANCH TO PICKUP CURRENT CCW ANCHOR. 03290000
L R7,VMSPNEXT AND NEXT CCW POINTER. 03291000
L R8,VMSPNUM PICKUP COUNT OF REMAINING CCWS. 03292000
LTR R8,R8 ALL DONE? 03293000
BNP VMSPEOB TRY NEXT BLOCK 03294000
EJECT 03295000
* 03296000
* HERE TO PROCESS NEXT CCW CHAIN. 03297000
* 03298000
VMSPCCW EQU * 03299000
* 03300000
* PRINTER 03301000
* DATA MOVING CCW'S ARE.. 03302000
* (0,1,8,9,A,B,C,D,E)(1,9) 03303000
* PLUS 63 BUT NOT 81 AND E9. 03304000
* PUNCH 03305000
* DATA MOVING CCW'S ARE.. 03306000
* (0,2,4,6,8,A)1 03307000
* 03308000
* READER 03309000
* DATA MOVING CCW'S ARE 02 AND 42 03310000
* THESE ARE PRESENT FOR REAL READER FILES. 03311000
* (AND REQUIRE DIFFERENT TREATMENT THAN VIRTUAL FILES 03312000
* FROM THE PRINTER OR PUNCH.) 03313000
* 03314000
* IMMEDIATE CCW OPS WITH NO DATA ARE.. 03315000
* (0,1,8,9,A,B,C,D,E)(B,3) 03316000
* EXCEPT 03,83, AND EB. 03317000
* 03318000
* 03 IS NOP (USED FOR PASSING SPOOL INFORMATION.) 03319000
* 08 IS TIC TO NEXT CCW CHAIN, IF ANY. 03320000
* 03321000
* AFTER PROCESSING A NON-TIC CCW CC SUCCESSFULLY, BCT TO VMSPCCW 03322000
* 03323000
VMSP4 EQU * 03324000
SPACE 2 03325000
* NOP (X'03') IS ASSUMED TO BE A DATA MOVER IF 03326000
* FOLLOWED BY A TIC, OTHERWISE IT IS IGNORED. 03327000
* 03328000
* 03329000
TM 0(R7),X'06' DECODE CCW 03330000
BZ VMSP1 IF DATA MOVER OR TIC 03331000
CLI 0(R7),X'63' AND 03332000
BE VMSPDATA IF THIS IS A LOAD OF FORMS BUFFER 03333000
CLI 0(R7),X'03' ALSO CHECK FOR A NOP AND 03334000
BE VMSPNOP IF IT IS. 03335000
* 03336000
***** CHECK FOR REAL READER FILES (42,02) IGNORE FOR MOMENT ****** 03337000
* 03338000
CLI 0(R7),X'42' REAL READER FILE? 03339000
BE VMSPFINI YES 03340000
CLI 0(R7),X'02' REAL READER OP 03341000
BE VMSPFINI YES 03342000
EJECT 03343000
* NOT DATA MOVER, TIC, OR END. IMMEDIATE IS ASSUMED. 03344000
* 03345000
VMSPIMED EQU * 03346000
MVC 0(1,R4),0(R7) MOVE IN CCW CC AND 03347000
MVI 1(R4),X'40' ONE BYTE OF DATA @VA03349 03348000
LA R3,1 SET BYTES COUNT 03349000
OI GETFLAGS,IMCMD SET ON IMM. COMM. FLAG 03350000
* 03351000
* HERE IF NON-TIC 03352000
* 03353000
VMSP2 EQU * 03354000
LA R7,8(R7) STEP TO NEXT CCW AND 03355000
CLI 0(R7),X'08' CHECK IF TIC 03356000
BE VMSP3 IF IT IS, ELSE 03357000
LR R6,R7 MOVE ANCHOR ALSO. THEN 03358000
VMSP3 EQU * 03359000
BCTR R8,0 REDUCE NUM OF RECORES IN BUFFER BY 1 03360000
B VMSPRET AND CONTINUE 03361000
SPACE 03362000
* 03363000
* HERE IF CCW IS XXXXX00X (BASE 2) 03364000
* 03365000
VMSP1 EQU * 03366000
TM 0(R7),X'01' CONTINUE DECODE 03367000
BO VMSPDATA IF CCW IS XXXXX001 03368000
CLI 0(R7),X'08' CHECK DIRECTLY FOR TIC 03369000
BE VMSPTIC IF YES. 03370000
SPACE 2 03371000
MSG 190,RDEVFID WRITE THE MESSAGE 03372000
B VMSPFINI TO IGNORE FOR PRESENT. 03373000
SPACE 3 03374000
VMSPTIC EQU * PROCESS TIC. 03375000
LH R7,2(R7) GET DISPLACEMENT OF NEXT CCW AND 03376000
AR R6,R7 ADD IN LAST ANCHOR TO GET NEW ONE. 03377000
LR R7,R6 TO INDICATE NEXT CCW TO BE PROCESSED 03378000
B VMSPCCW TO PROCESS IT. 03379000
EJECT 03380000
VMSPNOP EQU * PROCESS NOP 03381000
CLI 8(R7),X'08' LOOK AHEAD FOR TIC AND 03382000
BE VMSPDATA TREAT A DATA MOVER IF PRESENT. 03383000
LA R7,8(R7) UPDATE THE POINTER 03384000
LA R6,8(R6) BUMP ANCHOR PAST FIRST NOP @VA05953 03384100
BCTR R8,0 MINUS ONE 03385000
LTR R8,R8 CHECK THE REGISTER 03386000
BNP VMSPEOB TRY NEXT BLOCK 03387000
B VMSPCCW PROCESS NEXT CCW 03388000
SPACE 2 03389000
VMSPDATA EQU * HERE FOR DATA MOVING CCW CC. 03390000
SPACE 2 03391000
SR R3,R3 CLEAR REGISTER AND 03392000
IC R3,7(R7) TO LOAD COUNT FOR PACK. 03393000
LH R1,2(R7) GET OFFSET FROM ANCHOR FOR DATA 03394000
AR R1,R6 AND MAKE IT ABSOLUTE 03395000
MVC 0(1,R4),0(R7) MOVE IN CCW CC, THEN 03396000
EX R3,MAKEMVC MOVE IN DATA. 03397000
B VMSP2 TO JOIN COMMON CODE. 03398000
SPACE 3 03399000
VMSPEOB EQU * END OF A SPOOL BLOCK 03400000
NI GETFLAGS,X'FF'-FILLED RESET THE FLAG 03401000
B VMSPGET AND TRY TO GET A NEW ONE 03402000
SPACE 3 03403000
VMSPFINI EQU * ERROR RETURN 03404000
NI GETFLAGS,X'FF'-FILLED TO TURN OFF BLOCK FLAG AND 03405000
B MAKERET TO TRY FOR NEXT BLOCK. 03406000
SPACE 3 03407000
VMSPRET EQU * STANDARD RETURN 03408000
ST R6,VMSPANCH SAVE CCW ANCHOR. 03409000
ST R7,VMSPNEXT AND NEXT CCW 03410000
ST R8,VMSPNUM AND COUNT OF REMAINING CCW'S. 03411000
B MAKERETX TO COMPLETE RETURN. 03412000
EJECT 03413000
* TEMPORARIES 03414000
* 03415000
VMSPANCH DS F START OF PAGE BUFFER 03416000
VMSPNEXT DS F NEXT CCW IN PAGE BUFFER 03417000
VMSPNUM DS F NUM OF RECORDS IN PAGE BUFFER 03418000
SPACE 03419000
AXSSAVE DC 9F'0' AXS ROUTINE SAVE AREA 03420000
SPACE 03421000
AXSTRTAB DC C'0123456789ABCDEF' TR TABLE FOR CONVERT TO EBCDIC 03422000
SPACE 03423000
AXSCVD DC D'0' TEMP AREA FOR CVD CONVERSIONS 03424000
AXSRECS DC CL8' ' NUMBER OF RECORDS IN FILE 03425000
FILL DC CL8' ' FILLER FOR MSG 03426000
LOCATION DC CL8' ' HOST LOCATION 03427000
SYSTYPE DC CL8' ' REMOTE SYSTEM TYPE @VM01105 03428000
SPACE 1 03429000
HOLD EQU X'80' SUB OPTION ON CLOSE INPUT REQ 03430000
ALL EQU X'40' SUB OPTION ON CLOSE INPUT REQ 03431000
MULTOPEN EQU X'80' SUB OPTION FOR OUTPUT OPEN 03432000
EJECT 03433000
*. 03434000
* 03435000
* ENTRY NAME - 03436000
* 03437000
* AXSGET 03438000
* 03439000
* FUNCTION - 03440000
* 03441000
* THIS ROUTINE REQUESTS THE SPECIALIZED TASK AXS, 03442000
* TO OPEN, CLOSE AND DELETE THE SPOOL FILES THAT THE NPT 03443000
* TASK IS PROCESSING. 03444000
* 03445000
* CALLS TO OTHER ROUTINES - 03446000
* 03447000
* DMTAXS - TO OPEN AND CLOSE A INPUT DEVICE 03448000
* 03449000
* OPERATION - 03450000
* 03451000
* 1. INITIATE AND WAIT FOR COMPLETION A CALL TO DMTAXS 03452000
* FOR AN INPUT SPOOL FILE TO TRANSMIT. 03453000
* 03454000
* 2. IF FILE OPENED CONSTRUCT HEADER LINE AND SETUP INITIAL 03455000
* PARAMETERS FOR VMSP2CP. 03456000
* 03457000
* 3. IF FILE NOT OPENED RETURN TO CALLER WITH CONDITION CODE SET 03458000
* 03459000
* FOR A INPUT FILE PURGE: 03460000
* 03461000
* 1. SETUP UP A CALL TO DMTAXS TO CLOSE INPUT FILE 03462000
* 03463000
* 2. WAIT FOR COMPLETION AND RETURN TO CALLER. 03464000
* 03465000
* FOR AN ALERT EXIT: 03466000
* 03467000
* 1. TEST FOR REX OR AXS CALL IF AXS, SET FILREADY FLAG. 03468000
* 03469000
* 2. IF MSG INITIATE CALL TO PMSGREQ TO STACK MSG AND 03470000
* POST MSGECB. 03471000
* 03472000
* 3. IF COMMAND POST CMDECB. 03473000
* 03474000
* ENTRY CONDITIONS: 03475000
* 03476000
* IN REG. 14 THE RETURN ADDRESS 03477000
* IN REG. 9 THE SPOOL READER BLOCK POINTER 03478000
* 03479000
* EXIT CONDITIONS: 03480000
* 03481000
* NONE 03482000
EJECT 03483000
* 03484000
* NOTE: 03485000
* 03486000
* THE RETURN IS AT THE ADDRESS SPECIFIED IN THE REG. 14, 03487000
* IF THE REQUESTED FUNCTION HAS BEEN SUCCESFULLY 03488000
* COMPLETED. IN THE CASE OF FAILURE THE RETURN IS MADE 03489000
* AT THE ADDRESS SPECIFIED IN REG. 14 PLUS FOUR. 03490000
* IN CASE OF UNRECOVERABLE ERROR THE TASK ABORT ROUTINE 03491000
* IS ENTERED. 03492000
* THE ENTRY POINT AXSALERT IS THE ASYNCHRONOUS ENTRY FOR 03493000
* THE TASK. THE SUPERVISOR DISPATCHER ENTERS HERE WHEN 03494000
* A COMMUNICATION IS COMING FROM SOME OTHER TASK. 03495000
* 03496000
* RESPONSES - 03497000
* 03498000
* NONE 03499000
* 03500000
* ERROR MESSAGES - 03501000
* 03502000
* NONE 03503000
* 03504000
*. 03505000
SPACE 3 03506000
AXSGET DC 0H'0' 03507000
USING SPLINK,R1 GET PAGE SPOOL ADDR 03508000
USING TAG,R3 GET TAG ADDRESSABILITY 03509000
STM R14,R6,AXSSAVE SAVE CALLER'S REGISTER CONTENTS 03510000
NI RDEVFLAG,X'FF'-FILREADY SET READY FLAG OFF TO BE SAFE 03511000
MVI RDEVRLEN,X'13' SET REQUEST LENGTH 03512000
MVI RDEVFUN,X'01' SET FUNCTION FOR INPUT OPEN 03513000
MVC RDEVLINK(8),AXSLINK SET LINK ID IN REQUEST 03514000
SR R0,R0 CLEAR R0 TO SIGNAL GIVE INIT REQ 03515000
ST R0,RDRBLK CLEAR THE AXS REQUEST SYNCH LOCK TOO 03516000
LA R1,RDRBLK R1=ADDR OF THE REQ ELEMENT FOR AXS 03517000
L R15,GIVEREQ R15=ENTRY ADDR FOR SUP GIVE ROUT 03518000
BALR R14,R15 MAKE THE REQUEST AVAILABLE TO AXS0 03519000
L R15,WAITREQ R1=ADDR OF ENTRY TO WAIT ROUT 03520000
BALR R14,R15 WAIT FOR AXS0 TO PROCESS THE REQ 03521000
CLI RDRBLK,X'80' WAS THE REQUEST SUCCESSFUL? 03522000
BE AXSGOPEN YEP - GO TRY TO OPEN THE FILE 03523000
CLI RDRBLK,X'88' WAS THERE A SERIOUS ERROR? 03524000
* ERROR 11,8 QUIT IF CODE IS HIGHER THAN X'87' 03525000
LM R14,R1,AXSSAVE RESTORE CLOBBERED REGISTERS 03526000
B 4(R14) RETURN WITH NO BLOCK INDICATION 03527000
EJECT 03528000
AXSGOPEN EQU * 03529000
L R1,RDEVFIOA GET FILE I/O AREA ADDRESS 03530000
L R8,SPRECNUM PICKUP SPRECNUM FROM NEW BLOCK 03531000
ST R8,VMSPNUM PICKUP COUNT OF REMAINING CCWS 03532000
LA R6,SPRECNUM+4 SETP OVER POINTERS IN SPOOL BLOCK 03533000
ST R6,VMSPANCH TO PICKUP CURRENT CCW ANCHOR 03534000
ST R6,VMSPNEXT CCW POINTER AND NEXT 03535000
OI GETFLAGS,FILLED TO INDICATE BLOCK PRESENT 03536000
OI RDEVFLAG,FILACTIV+FILREADY SET APPROPRIATE FLAGS 03537000
L R3,RDEVTAG REG.3 = ADDR OF NEW FILE TAG 03538000
CLI TAGINDEV,TYP3210 IS A SPOOL CONSOLE FILE? 03539000
BE AXSGLINE YES..TREAT LIKE PRINT 03540000
TM TAGINDEV,TYPPRT IS IT A PRINT FILE? 03541000
BO AXSGLINE YEP - GO GIN UP A REMOTE HEADER LINE 03542000
MVC RDEVSTYL(5),=C'PUNCH' SET STYLE IN READER TABLE 03543000
SPACE 03544000
MVI HDRCHAR,X'5C' INSERT * 03545000
MVC HDRCHAR+1(80-HDRSGLEN-1),HDRCHAR SET HEADER 03546000
B AXSGCOMM AND CONTINUE 03547000
SPACE 1 03548000
AXSGLINE EQU * 03549000
MVC HDRDIST(8),TAGDIST MOVE IN THE DIST CODE 03550000
MVC HDRNAME(24),TAGNAME AND THE FILE NAME 03551000
MVC RDEVSTYL(5),=C'PRINT' SET STYLE IN READER TABLE 03552000
MVI HDRCHAR,X'40' INSERT BLANK 03553000
MVC HDRCHAR+1(80-HDRSGLEN-1),HDRCHAR 03554000
AXSGCOMM EQU * 03555000
MVC HDRORGID(8),TAGINLOC MOVE IN THE ORIGIN LOCATION ID 03556000
MVC HDRVMID(8),TAGINVM MOVE IN THE ORIGIN VM ID 03557000
MVC HDRTOD(MASKLEN),TODMASK MOVE IN THE EDITING MASK 03558000
LM R0,R1,TAGINTOD R0 & 1 = S/370 TOD OF FILE ORIGIN 03559000
LA R2,HDRTOD R2 = ADDR OF FIELD TO BE EDITED 03560000
BAL R14,TODEBCD CONV THE S/370 TOD TO READABLE FORM 03561000
AXSGEXIT EQU * 03562000
LA R14,HEADTABL RESET THE HEADER TABLE POINTER 03563000
ST R14,HEADPNT AND SAVE IT 03564000
LM R14,R6,AXSSAVE RESTORE ALL REGISTERS 03565000
BR R14 AND RETURN TO THE MAIN ROUTINE 03566000
DROP R1,R3 DROP ADDRESSABILTIY 03567000
SPACE 03568000
EJECT 03569000
AXSPURGE EQU * 03570000
STM R14,R1,AXSSAVE SAVE CALLER'S REGISTER CONTENTS 03571000
MVI RDEVFUN,X'02' SET PURGE REQUEST CODE FOR AXS 03572000
SR R0,R0 CLEAR R0 TO SIGNAL GIVE INIT REQ 03573000
ST R0,RDRBLK CLEAR THE REQUEST SYNCH LOCK TOO 03574000
LA R1,RDRBLK R1=ADDR OF PURGE REQUEST FOR AXS 03575000
L R15,GIVEREQ R15=ADDR OF ENTRY TO SUP GIVE ROUT 03576000
BALR R14,R15 INITIATE THE REQUEST 03577000
L R15,WAITREQ R15=ADDR OF ENTRY TO SUP WAIT ROUT 03578000
BALR R14,R15 WAIT FOR THE REQUEST TO BE COMPLETED 03579000
NI RDEVFLAG,X'FF'-FILACTIV SET THE READER INACTIVE 03580000
MVI RDEVSOPT,X'00' RESET SUB OPTION BYTE 03581000
LM R14,R1,AXSSAVE RESTORE CLOBBERED REGISTERS 03582000
BR R14 AND RETURN TO THE CALLER 03583000
EJECT 03584000
AXSALERT EQU * ASYNCHRONOUS TASK ALERT ROUTINE 03585000
L R12,TASKSAVE-TASKE(R13) RESTORE BASE REGISTER 03586000
LM R9,R11,NPTREG9 RESTORE OTHER BASES 03587000
CL R0,AXSNAME IS THIS THE FILE ACCESS MANAGER CALL 03588000
BC 7,AXSALRT1 IGNORE IT IF IT ISN'T 03589000
OI RDRBLK+RDEVFLAG-REQBLOCK,FILREADY ELSE FLAG READY FILE 03590000
BR R14 AND RETURN TO THE DISPATCHER 03591000
SPACE 1 03592000
AXSALRT1 EQU * 03593000
CL R0,REXNAME IS IT THE COMMAND PROCESSOR CALLING? 03594000
BC 7,AXSTDLY GO CHECK FOR A TIMER INTP @VA03349 03595000
CLI 1(R1),MSGCMD IS IT A MSG COMMAND? 03596000
BE AXSMENQ HAVE TO STACK IT FOR LATER 03597000
CLI CMDINPGS,X'FF' ARE WE PROCESSING ONE ALREADY? 03598000
BE AXSCMD YEP - MUST IGNORE THIS ONE 03599000
MVI 2(R1),X'00' INDICATE WE ACCEPT THIS ONE 03600000
OI CMDINPGS,X'FF' SHOW WE ARE PROCESSING A COMMAND 03601000
SR R15,R15 CLEAR OUT FOR IC 03602000
IC R15,0(R1) GET COMMAND ELEMENT LENGTH 03603000
EX R15,CMDMVC MOVE TO OUT BUFFER 03604000
SR R0,R0 CLEAR FOR POST 03605000
LA R1,CMDECB GET THE COMMAND SYNCH LOCK ADDR 03606000
L R15,POSTREQ SYSTEM POST FUNCTION 03607000
BR R15 GO POST THE SYNCH LOCK 03608000
SPACE 1 03609000
AXSCMD EQU * 03610000
MVI 2(R1),X'80' INDICATE WE CANNOT ACCEPT NOW 03611000
BR R14 AND RETURN 03612000
SPACE 1 03613000
AXSMENQ EQU * 03614000
L R2,NPTALINK GET MY LINK TABLE ADDR 03615000
LA R13,COMSAVE USE THIS SAVE AREA 03616000
L R15,TCOM GET COMMON ROUTINE TABLE ADDR 03617000
L R15,PMSGREQ AND THE MSG STACK ROUTINE ADDR 03618000
LR R3,R14 SAVE RETURN REGISTER 03619000
BALR R14,R15 GO TRY TO STACK MSG 03620000
LR R14,R3 RESTORE RETURN REG 03621000
LTR R15,R15 STACKED OKAY? 03622000
BNZ AXSCMD NO EXIT 03623000
MVI 2(R1),X'00' ACCEPT MSG 03624000
OI GETFLAGS,MSGQUED INDICATE MSGS PRESENT 03625000
BR R14 AND RETURN 03626000
AXSTDLY CH R0,TDCODE IS IT THE TIMER @VA03349 03627000
BCR 7,R14 NO, IGNORE IT @VA03349 03628000
SR R0,R0 SET UP FOR POST @VA03349 03629000
LA R1,TIMERECB @VA03349 03630000
L R15,POSTREQ GET ADDRESS OF POST ROUTINE @VA03349 03631000
BR R15 GO POST THE TIMERECB @VA03349 03632000
SPACE 1 03633000
CMDMVC MVC CMDRESP(0),0(R1) TO BE EXECUTED BY ABOVE CODE 03634000
SPACE 1 03635000
DS 0F 03636000
CMDECB DC F'0' COMMAND SYNCH LOCK 03637000
CMDRESP DC CL132' ' COMMAND BUFFER 03638000
CMDINPGS DC X'00' COMMAND IN PROGRESS SWITCH 03639000
COMSAVE DC 18F'0' COMMON ROUTINE SAVE AREA 03640000
EJECT 03641000
HDRLINE DC X'19' PRINT LINE AND SPACE THREE COMMAND 03642000
HDRSGTOP EQU * START OF HEADER TEXT 03643000
HDRORGID DC 8C'Y' FILE ORIGIN LOCATION ID 03644000
DC 4C' ' FOUR BLANKS 03645000
HDRVMID DC 8C'X' FILE ORIGIN VIRTUAL MACHINE ID 03646000
DC 3C' ' THREE MORE BLANKS 03647000
HDRTOD DC C' ' BEGINNING OF FIELD TO BE EDITED 03648000
DC C'XX/XX/XX' FILE ORIGIN DATE FROM TOD ROUTINE 03649000
DC 4C' ' FOUR MORE BLANKS 03650000
DC C'YY:YY:YY' FILE ORIGIN TIME FROM TOD ROUTINE 03651000
DC 2C' ' TWO MORE BLANKS 03652000
DC 6C' ' SIX MORE BLANKS @VA03113 03653500
DC C' WAS THE ORIGIN' ENDING NOTE 03654000
HDRSGLEN EQU (*-HDRSGTOP) END OF THE SEGMENT DATA FIELD 03655000
HDRCHAR DC (80-HDRSGLEN)C' ' FILLER 03656000
HDRLEN EQU (*-HDRLINE) END OF HEADER LINE RECORD 03657000
SPACE 03658000
TODMASK DC AL1(MASKLEN-1) LENGTH OF REMAINING MASK FIELD 03659000
DC X'2120',C'/',X'2020',C'/',X'2020' DATE MASK 03660000
DC 3C' ' THREE BLANKS 03661000
DC X'22' RESET SIGNIFICANCE INDICATOR 03662000
DC X'2120',C':',X'2020',C':',X'2020' TIME MASK 03663000
DC 2C' ' 2 MORE BLANKS TO SEP ENDING NOTE @VA03113 03664500
MASKLEN EQU (*-TODMASK) END OF EDIT MASK 03665000
SPACE 2 03666000
HDRLINE2 EQU * START OF SECOND HEADER LINE 03667000
DC X'19' PRINT AND SPACE 3 03668000
DC C'DEST: ' 03669000
HDRLINK DC CL8' ' LINK ID 03670000
DC C' FILE: ' 03671000
HDRFILE DC CL4' ' SPOOL FILE ID 03672000
DC C' NAME: ' 03673000
HDRNAME DC CL24' ' FILE NAME AND TYPE 03674000
DC C' DIST: ' 03675000
HDRDIST DC CL8' ' DISTRIBUTION CODE 03676000
DC C' RECS: ' 03677000
HDRRECS DC CL8' ' NUMBER OF RECORDS 03678000
LHDRLIN2 EQU *-HDRLINE2 LENGTH OF SECOND HDR LINE 03679000
EJECT 03680000
*. 03681000
* 03682000
* ENTRY NAME - 03683000
* 03684000
* TODEBCD 03685000
* 03686000
* FUNCTION - 03687000
* 03688000
* CONVERT S/370 TOD TO EBCDIC DATE AND TIME 03689000
* 03690000
* CALLS TO OTHER ROUTINES - 03691000
* 03692000
* GTODEBCD - TO CONVERT THE TIME AND DATE 03693000
* 03694000
* OPERATION - 03695000
* 03696000
* 1. SAVE REGISTERS 03697000
* 03698000
* 2. ISSUE CALL TO SUPERVISOR ROUTINE FOR TIME CONVERSION 03699000
* 03700000
* 3. RESTORE REGISTERS AND RETURN. 03701000
* 03702000
* RESPONSES - 03703000
* 03704000
* NONE 03705000
* 03706000
* ERROR MESSAGES - 03707000
* 03708000
* NONE 03709000
* 03710000
*. 03711000
SPACE 3 03712000
TODEBCD DC 0H'0' 03713000
STM R13,R14,TODSAVE1 SAVE RETURN 03714000
LA R13,MMDDYYHH GET WORK ADDR ADDR FOR CALL 03715000
L R15,TCOM GET COMMON ROUTINE ADDR 03716000
L R15,GTODEBCD AND THE TIME CONVERT ADDR 03717000
BALR R14,R15 AND DO IT 03718000
LM R13,R14,TODSAVE1 RESTORE REGS 03719000
BR R14 AND RETURN 03720000
EJECT 03721000
MMDDYYHH DC D'0' TO HOLD NEW HOUR CALCULATION IN DEC 03722000
DC D'0' FOR APPENDING MMDDYYHH TO MMSSMMMM 03723000
MMSSMMMM DC D'0' TO RECEIVE DECIMAL MINUTE AND SECOND 03724000
DAYNUMBR DC A(0) TO RECEIVE COMPUTED DAY OF WEEK 0->6 03725000
TODEBCON DC F'-1',A(0+4,TIMEZON+4) SEE BELOW 03726000
* DC F'-1' TO HOLD LAST CALCULATION ELAPSED HOURS 03727000
* DC A(0+4) SWITCH, USED AS AN INDEX, FOR STD VS. DLT TIME 03728000
* DC A(TIMEZON+4) EXTERNAL ADDRESS OF TIMEZONE DISP TABLE 03729000
TODSAVE DC 11F'0' TODEBCD ROUTINE SAVE AREA 03730000
SPACE 03731000
TODSAVE1 DC 2F'0' SAVE AREA 03732000
SPACE 03733000
TIMEZON DC Y(0),CL6' ' DONT CONVERT TIME ZONE @VA03113 03734400
DC Y(0),CL6' ' ITS CORRECT AS IT IS @VA03113 03734800
EJECT 03736000
*. 03737000
* 03738000
* ENTRY NAME - 03739000
* 03740000
* PARMGET 03741000
* 03742000
* FUNCTION - 03743000
* 03744000
* LINE SCANNING SUBROUTINE 03745000
* 03746000
* CALLS TO OTHER ROUTINES - 03747000
* 03748000
* NONE 03749000
* 03750000
* OPERATION - 03751000
* 03752000
* 1. TEST FOR DELEMITER CHARACTER 03753000
* 03754000
* 2. WHEN FOUND OF END OF STRING FOUND UPDATE R4 03755000
* 03756000
* 3. AND RETURN 03757000
* 03758000
* ENTRY - 03759000
* 03760000
* REG.3 = ADDRESS OF START OF STRING 03761000
* REG.5 = ADDRESS OF END OF STRING 03762000
* 03763000
* EXIT - 03764000
* 03765000
* REG.3 = FIRST NONDELIMETER CHARACTER SCANNED; 03766000
* IF NONE FOUND, END OF STRING 03767000
* REG.4 = UNMODIFIED IF NO NONDELIMETER CHAR SCANNED; 03768000
* OTHERWISE, ADDRESS OF FIRST DELIMETER CHAR 03769000
* AFTER FIRST NONDELIMETER CHAR SCANNED; 03770000
* IF NONE, END OF STRING. 03771000
* REG.5 = UNMODIFIED 03772000
* 03773000
* A DELIMETER CHAR IS ANY CHARACTER OF THE FORM B'XX000000' 03774000
* 03775000
* RESPONSES - 03776000
* 03777000
* NONE 03778000
* 03779000
* ERROR MESSAGES - 03780000
* 03781000
* NONE 03782000
* 03783000
*. 03784000
EJECT 03785000
PARMGET DC 0H'0' 03786000
LA R5,0(R5) CLEAR HIGH ORDER BYTE JUST IN CASE 03787000
BCTR R3,0 BUMP STA OF STRING PTR BACK FOR CONV 03788000
PARMFIND EQU * 03789000
LA R3,1(R3) LOOK AT THE NEXT CHARACTER 03790000
CLR R3,R5 HAVE WE HIT THE END OF THE STRING? 03791000
BCR 11,R14 (BNL) YEP - LOOK NO MORE 03792000
TM 0(R3),X'BF' IS THIS CHARACTER A DELIMITER? @VA03345 03793000
BZ PARMFIND YEP-KEEP LOOKING FOR A NONDELIMETER 03794000
LR R4,R3 SET UP FOR NEXT PHASE OF SCAN 03795000
PARMSCAN EQU * 03796000
LA R4,1(R4) LOOK AT THE NEXT CHARACTER 03797000
CLR R4,R5 ARE WE AT THE END OF THE STRING YET? 03798000
BCR 11,R14 (BNL) RETURN IMMEDIATELY IF SO 03799000
CLI 0(R4),X'7E' IS IT EQUAL (=) SIGN @VA05955 03799250
BER R14 YES THIS IS END @VA05955 03799500
TM 0(R4),X'BF' IS THIS CHARACTER A DELIMITER? @VA03345 03800000
BNZ PARMSCAN KEEP SCANNING FOR A DELIMETER IF NOT 03801000
BR R14 OTHERWISE ALL DONE - RETURN 03802000
EJECT 03803000
*---------------------------------------------------------------------* 03804000
* * 03805000
* NPTINIT -- INITIALIZATION ROUTINE * 03806000
* * 03807000
*---------------------------------------------------------------------* 03808000
SPACE 03809000
NPTALINK DC A(0) LINK TABLE ADDRESS 03810000
AXSLINK DC CL8' ' LINKID TO BE FILLED IN BY INIT 03811000
AXSNAME DC CL4'AXS ' FILE ACCESS MANAGER TASK NAME 03812000
REXNAME DC CL4'REX ' CONTROL TASK NAME 03813000
NPTLINE DC CL8' ' NPT EBCDIC LINE ADDRESS 03814000
NPTPASS DC CL8' ' NPT PASSWORD 03815000
EJECT 03816000
*. 03817000
* 03818000
* ENTRY NAME - 03819000
* 03820000
* NPTINIT 03821000
* 03822000
* FUNCTION - 03823000
* 03824000
* NPT INITIALIZATION ROUTINE 03825000
* 03826000
* CALLS TO OTHER ROUTINES - 03827000
* 03828000
* GPAGEREQ - TO RESERVE A PAGE OF STORAGE FOR THE OUTPUT BUFFER 03829000
* DMTASY - TO SET AN ASYNCH EXIT 03830000
* 03831000
* OPERATION - 03832000
* 03833000
* 1. SETUP THE LINE ADDRESS FROM THE LINK TABLE 03834000
* 03835000
* 2. INITIALIZE PUNCH AND LOG TAGS. 03836000
* 03837000
* 3. INITIALIZE ASYNCH EXIT 03838000
* 03839000
* 4. INITIALIZE OUTPUT TP BUFFER BY GETTING A PAGE FROM 03840000
* THE GPAGEREQ ROUTINE. 03841000
* 03842000
* 5. ISSUE MSG 141 AND WAIT FOR LINE CONNECTION. 03843000
* 03844000
* 6. WHEN THE I/O COMPLETES WITHOUT ERROR, CONTINUE 03845000
* TO READ THE SIGNON CARD. 03846000
* 03847000
* RESPONSES - 03848000
* 03849000
* DMTNPT141I LINK 'VADDR' READY FOR CONNECTION TO LINK 'LINKID' 03850000
* DMTNPT142I LINK 'LINKID' LINE 'VADDR' CONNECTED 03851000
* 03852000
* ERROR MESSAGES - 03853000
* 03854000
* NONE 03855000
* 03856000
*. 03857000
SPACE 3 03858000
NPTINIT DC 0H'0' 03859000
USING TAG,R8 GET TAG ADDRESSABILITY 03860000
LTR R0,R0 WAS A PARAMETER SPECIFIED? 03861000
BZ NPTNOPAS NO PASSWORD SPECIFIED 03862000
LR R7,R0 GET PARM FIELD LENGTH 03863000
BCTR R7,0 SUBSTACT 1 03864000
EX R7,NPTPSMVC MOVE PASSWORD 03865000
EJECT 03866000
NPTNOPAS EQU * 03867000
SPACE 03868000
* SET UP THE LINE ADDRESS 03869000
ST R2,NPTALINK SAVE THE LINK TABLE ADDRESS 03870000
LR R7,R2 LOAD FOR DSECT REFERENCE 03871000
LA R13,LINE SET LINE ADDR DEVICE BLOCK 03872000
MVC DEVADDR(2),LACTLINE SAVE THE DEVICE ADDRESS FOR THE 03873000
MVC AXSLINK(8),LINKID AND THE LINK ID FOR AXS 03874000
MVC HDRLINK(8),LINKID AND THE LINK ID FOR AXS 03875000
L R15,TLINKS GET START OF LINK TABLE CHAIN 03876000
LA R7,8(R15) GET THE FIRST ENTRY (LOCAL) 03877000
MVC LOCATION(8),LINKID AND SAVE IT FOR MSGS 03878000
SPACE 03879000
* INITIALIZE PUNCH TAGS 03880000
SPACE 03881000
LA R8,PUNTAG GET PUNCH TAG ADDRESS 03882000
MVI TAGINDEV,TYPPUN SET PUNCH DEVICE TYPE 03883000
MVC TAGINLOC(8),AXSLINK SET LOCATION ID 03884000
MVC TAGDIST(8),AXSLINK SET LOCATION ID 03885000
MVC TAGLINK(8),AXSLINK SET DEFAULT LINK @VA03300 03886000
MVC TAGTOLOC(8),LOCATION SET DEFAULT TOLOC @VA03300 03887000
MVI PUNREQ+3,MULTOPEN INDICATE MULTIPLE OPEN ON OUTPUT 03888000
MVC PUNREQ+12(8),AXSLINK SET LOCATION ID 03889000
SPACE 03890000
LA R8,LOGTAG GET LOG TAG ADDRESS 03891000
MVI TAGINDEV,TYPPRT SET PRINTER DEVICE TYPE 03892000
MVC TAGINLOC(8),AXSLINK SET LOCATION ID 03893000
MVC TAGDIST(8),AXSLINK SET LOCATION ID 03894000
MVC TAGLINK(8),AXSLINK SET DEFAULT LINK @VA03300 03895000
MVC TAGTOLOC(8),LOCATION SET DEFAULT TOLOC @VA03300 03896000
MVC LOGGREQ+12(R8),AXSLINK SET LOCATION ID 03897000
MVI LOGGREQ+3,MULTOPEN SET MULTOPEN FOR PRT 03898000
SPACE 03899000
* INITIALIZE TASK ASYNCH SIGNAL EXIT 03900000
SR R0,R0 REG.R0 = R0 FOR ALERT EXIT REQUEST 03901000
LA R1,AXSALERT REG.1 = ADDR OF ASYNCH EXIT 03902000
L R15,ASYNREQ R15=ADDR OF ENTRY TO SUP ASYN ROUT 03903000
BALR R14,R15 INITIALIZE THE ALERT ASYNCH EXIT 03904000
SPACE 1 03905000
* INITIALIZE BUFFERS 03906000
L R15,TCOM GET COMMON ROUTINE LIST ADDR 03907000
L R15,GPAGEREQ GET THE GETPAGE ROUTINE ADDR 03908000
LA R13,COMSAVE USE THIS SAVE AREA 03909000
BALR R14,R15 GO GET A PAGE 03910000
ST R1,LINEBUFF STORE BUFFER ADDR 03911000
ST R1,STARTLIN STORE BUFFER ADDR 03912000
STCM R1,B'0111',TRANSMIT+1 SRTORE BUFFER ADDRESS @VA03349 03913000
EJECT 03914000
* INITIALIZE 03915000
SPACE 03916000
NPTENABL EQU * 03917000
LA R13,LINE R13 = BASE REG. FOR LINE DEV TABLE 03918000
MVC DEVSTART(4),=A(ENABPROG) SET CHAN ADDR TO ENABLING SEQ 03919000
NPTEINIT EQU * 03920000
L R7,NPTALINK GET LINK TABLE ADDRESS 03921000
UNPK NPTLINE(5),LACTLINE(3) GET THE ACTIVE LINE ADDR 03922000
MVC NPTLINE(3),NPTLINE+1 MOVE INTO FIRST THREE BYTES OF MSG 03923000
MVI NPTLINE+3,C' ' BLANK THE FIELD 03924000
MVC NPTLINE+4(4),NPTLINE+3 AND BLANK THE REST 03925000
TR NPTLINE(3),AXSTRTAB-240 CONVERT TO EBCDIC 03926000
MSG 141,(NPTLINE,AXSLINK) 03927000
BAL R14,LINEIO EXECUTE THE ENABLING SEQUENCE 03928000
TM DEVFLAGS,IOERR WAS THERE ANY TROUBLE? 03929000
BNZ NPTEINIT YES - TRY THE WHOLE THING AGAIN 03930000
MSG 142,(AXSLINK,NPTLINE) WRITE MSG 03931000
B NPTLINK AND CONTINUE 03932000
SPACE 03933000
NPTPSMVC MVC NPTPASS(0),0(R1) TO BE EXECUTED FROM ABOVE 03934000
DROP R8 DROP DSECT ADDRESSABILITY 03935000
EJECT 03936000
*. 03937000
* 03938000
* ENTRY NAME - 03939000
* 03940000
* NPTLINK 03941000
* 03942000
* FUNCTION - 03943000
* 03944000
* NPT SIGNON ROUTINE 03945000
* 03946000
* CALLS TO OTHER ROUTINES - 03947000
* 03948000
* NONE 03949000
* 03950000
* OPERATION - 03951000
* 03952000
* 1. ISSUE READ INITIALS UNTIL AN I/O IS SUCCESSFULLY COMPLETED. 03953000
* 03954000
* 2. ANALYZE SIGNON CARD. 03955000
* 03956000
* 3. SET NPT PARAMETERS FROM SIGNON CARD. 03957000
* 03958000
* 4. WHEN END OF SIGNON CARD IS REACHED, SET DEFAULTS FOR 03959000
* UNSPECIFIED PARAMETERS. 03960000
* 03961000
* 5. EXIT TO NPTGET 03962000
* 03963000
* RESPONSES - 03964000
* 03965000
* DMTNPT905I SIGNON OF LINK 'LINKID' COMPLETE 03966000
* 03967000
* ERROR MESSAGES - 03968000
* 03969000
* DMTNPT902E NON-SIGNON CARD READ ON LINK 'LINKID' 03970000
* DMTNPT903E PASSWORD SUPPLIED ON LINK 'LINKID' IS INVALID 03971000
* DMTNPT904E SIGNON PARAMETER='PARM' ON LINK 'LINKID' 03972000
* INVALID 03973000
* DMTNPT907E SIGNON TYPE PARAMETER MISSING @VA03420 03974000
* 03975000
*. 03976000
SPACE 3 03977000
* 03977100
* IF LAST OPERATION ENDED WITH A TIMEOUT 03977200
* TAKE A TEN SECOND DELAY TO PREVENT CONTINUOUS POLLING 03977300
* 03977400
NPTLINKD TM DEVSENSE,TIMEOUT WAS LAST ERROR A TIMEOUT @VA04358 03977500
BZ NPTLINK NO, RETRY THE OPERATION @VA04358 03977600
LA R0,10 TEN SECOND DELAY @VA04358 03977700
BAL R14,TDELAY TAKE TEN @VA04358 03977800
* 03977900
NPTLINK EQU * 03978000
MVC DEVSTART,=A(READINIT) CCW TO SEE IF DEVICE IS @VA03349 03979000
* READY 03980000
BAL R14,LINEIO START READING LINE 03981000
TM DEVFLAGS,IOERR DID WE READ ANYTHING SUCCESFULLY? 03982000
BO NPTLINKD NOPE - READ AGAIN @VA04358 03983100
CLI INIT,ENQ WAS IT READY @VA03349 03984000
BE NPTLINK1 YES - CONTINUE 03985000
CLI INIT+2,ENQ MIGHT HAVE TERMINAL ID FEATURE @VA03349 03986000
BNE NPTLINK NO - TRY AGAIN @VA03529 03987000
EJECT 03988000
NPTLINK1 EQU * 03989000
MVC EXPRESP(2),INITACK0 SET UP INITIAL EXP RESP @VA03349 03990000
MVC RESP(2),INITACK0 SET UP INITIAL RESPONSE @VA03349 03991000
NPTLWAIT EQU * 03992000
MVC DEVSTART,=A(RECEIVE) SET UP TO RECEIVE FROM @VA03349 03993000
* DEVICE 03994000
BAL R14,LINEIO WRITE DLE,ACK0 AND LISTEN 03995000
TM DEVFLAGS,IOERR EVERYTHING O.K. ? 03996000
BNO CONFCK YES - GO TO CHECK IT 03997000
TM DEVCSW+4,UC WAS PROBLEM A UNIT CHECK? 03998000
BNO NPTLEOT NO - MUST BE CONTENTION TRY AGAIN 03999000
TM DEVSENSE,TIMEOUT DID WE TIMEOUT? 04000000
BO NPTLEOT YES..MUST SEND EOT 04001000
NPTLNAK EQU * 04002000
MVC DEVSTART(4),=A(NAKPROG) OTHERWISE MUST BE LINE ERROR 04003000
BAL R14,LINEIO WRITE NAK AND LISTEN 04004000
TM DEVFLAGS,IOERR EVERYTHING O.K.? 04005000
BO NPTLNAK NO - GO TO REPEAT 04006000
CONFCK EQU * 04007000
LA R1,LINEINB SET POINTER REGISTER 04008000
CLI LINEINB,STX IS THE FIRST CHARACTER STX? 04009000
BE CONFCK1 YES - CONTINUE 04010000
CLI LINEINB,ENQ IS IT ENQ? 04011000
BE NPTLWAIT YES - REINIT RESPONSE 04012000
CLI LINEINB,EOT DID WE RECEIVE AN EOT? 04013000
BNE NPTLNAK1 NO - CHECK TRANSPARENCY FEATURE 04014000
MVC RESP(2),INITACK0 @VA03349 04015000
MVC EXPRESP(2),INITACK0 EOT ALWAYS STARTS SEQ OVER @VA03349 04016000
TM DEVFEAT,X'00'+REM2780+REM2770 ANYTHING SPECIFIED? 04017000
BM LINKEXIT YES GO TO SEND MESSAGE 04018000
B NPTLINK START OVER @VA04171 04019500
SPACE 1 04021000
NPTLNAK1 EQU * 04022000
CLC LINEINB(2),=AL1(DLE,STX) START OF TEXT? 04023000
BNE NPTLNAK NO -SEND NAK 04024000
OI PUTFLAGS,TRANSP @VA03349 04025000
LA R1,1(0,R1) ADJUST POINTER 04026000
B CONFCK1 AND GO TO CHECK CARD 04027000
SPACE 04028000
NPTLEOT EQU * 04029000
MVC DEVSTART(4),=A(EOTPROG) SET EOT PROGRAM 04030000
MVC RESP(2),INITACK0 @VA03349 04031000
MVC EXPRESP(2),INITACK0 EOT ALWAYS STARTS SEQ OVER @VA03349 04032000
BAL R14,LINEIO ISSUE THE LINEIO 04033000
TM DEVFLAGS,IOERR END IN ERROR? 04034000
BO NPTLEOT SEND EOT 04035000
B NPTLINK AND CONTINUE @VA03529 04036000
SPACE 04037000
EJECT 04038000
CONFCK1 EQU * @VA03821 04039000
CLI 1(R1),ENQ ENQ FOLLOWING STX? (IE., TTD) @VA03821 04040000
BNE CONFCK1A NO @VA03349 04041000
LA R0,2 TAKE A TWO SECOND DELAY @VA03349 04042000
BAL R14,TDELAY @VA03349 04043000
B NPTLNAK GO RESPOND WITH A NACK @VA03349 04044000
CONFCK1A LA R1,1(0,R1) OVER THE STX @VA03349 04045000
LR R2,R1 POINTER INTO R2 @VA03112 04046000
BAL R14,DECM DECOMPRESS - JUST IN CASE @VA03112 04047000
LA R1,0(R1) CLEAR THE HI BYTE @VA03349 04048000
CLI 0(R1),IGS IS IT AN IGS ? @VA04618 04048300
BNE CONFCK1B NO, CONTINUE. @VA04618 04048550
LA R1,2(0,R1) YES, BUMP PAST IGS AND COUNT @VA04618 04048800
CONFCK1B ST R1,SCANTERM SAVE ADDRESS FOR LATER @VA04618 04049000
* ADDR IS END OF CURRENT SCAN 04050000
L R15,DEVCSW GET ENDING ADDRESS @VA03349 04051000
S R15,=F'8' BACK UP TO LAST EXECUTED CCW @VA03349 04052000
LH R14,6(R15) GET ORIGINAL CCW COUNT @VA03349 04053000
SH R14,DEVCSW+6 MINUS RESIDUAL COUNT @VA03349 04054000
ST R14,RCOUNT SAVE ACTUAL COUNT OF XMITTED BYTE@VA03349 04055000
LA R15,LINEINB POINT TO FIRST BYTE @VA04944 04055150
AR R15,R14 POINT TO LAST BYTE PLUS ONE @VA04944 04055300
BCTR R15,0 BACK TO LAST BYTE @VA04944 04055450
CLI 0(R15),ENQ ENQ AT END OF BLOCK? @VA04944 04055600
BE NPTLNAK BRANCH IF YES, DISCARD @VA04944 04055750
OC 0(80,R2),BLANKS UPPER CASE THE SIGNON CARD ONLY @VA03349 04056000
LR R1,R2 POINTER BACK INTO R1 @VA03112 04057000
CLC 0(7,R1),=C'SIGNON ' FIRST CARD SIGNON CARD @VA03349 04058000
BE CONFCK2 YES, CONTINUE @VA03529 04059000
OI INTFLAG,WSEM+NOSIGN INDICATE SIGNON ERROR MSG @VA03349 04060000
MSG 902,AXSLINK NO, WRITE ERROR MSG @VA03529 04061000
B SGNM GO WRITE ERROR TO DEVICE @VA03349 04062000
SPACE 1 04063000
CONFCK2 EQU * 04064000
LA R3,7(,R1) GET FIRST POSSIBLE LINK POSITION @VA04357 04065000
LA R5,20(R1) SET MAX AT +20 FROM THERE 04066000
BAL R14,PARMGET FRAME THE LINKID 04067000
LR R6,R4 GET THE LAST CHAR ADDR 04068000
SR R6,R3 CALCULATE THE LENGTH 04069000
CL R6,LNKMAX TOO LONG? 04070000
BNH CONTINUE NO--CONTINUE @VA03423 04071000
L R6,LNKMAX USE MAX OF 8 AS LENGTH @VA03423 04072000
OI INTFLAG,WSEM+NOLINK INDICATE SIGON ERROR MSG @VA03349 04073000
BCTR R6,0 @VA04171 04073200
EX R6,LNKMVC MOVE IN PASSWORD @VA04171 04073400
BAL R8,SGNERR GO SEND ERROR MSG @VA04171 04073600
B CONTINU1 @VA04171 04073800
CONTINUE EQU * @VA03423 04074000
BCTR R6,0 REDUCE BY ONE FOR MVC 04075000
EX R6,LNKMVC AND MOVE TO STAGING AREA 04076000
CLC SGNEPARM(8),AXSLINK RIGHT LINK? 04077000
BE CONTINU1 YES, KEEP GOING @VA03349 04078000
OI INTFLAG,WSEM+NOLINK INDICATE ERROR @VA03349 04079000
BAL R8,SGNERR GO QUEUE THE MESSAGE @VA03349 04080000
CONTINU1 SLR R4,R3 CALCULATE LENGTH OF PARM @VA03349 04081000
LA R3,1(R4,R3) CALCULATE NEXT PARM START 04082000
MVI SGNEPARM,X'40' BLANK FIRST CHARACTER 04084000
MVC SGNEPARM+1(7),SGNEPARM AND BLANK THE REST 04085000
TM NPTFLAGS,RENBL ARE WE RE-ENABLING? @VA03529 04086000
BO SGNERR2 YES GO CHECK FOR ERRORS @VA05792 04087510
B SCANCD AND CONTINUE 04088000
SPACE 1 04089000
LNKMVC MVC SGNEPARM(0),0(R3) TO BE EXECUTED FROM ABOVE 04090000
SCANTERM DC F'0' DECOMPRESS TERMINATION ADDR @VA03349 04091000
BLANKS DC CL80' ' UPPER CASE CONSTANT @VA03349 04092000
EJECT 04093000
SCANCD EQU * 04094000
LA R5,80(0,R1) POINT TO END OF OUTCARD @VA03349 04095000
FNDEND EQU * 04096000
BAL R14,PARMGET FRAME THE NEXT PARAMETER 04097000
CR R3,R5 IS THIS THE END? 04098000
BNL ENDSCAN YES..EXIT LOOP 04099000
LR R6,R4 GET START OF FIELD 04100000
SR R6,R3 AND THE LENGTH 04101000
CL R6,SGNMAX TOO LONG 04102000
BNH SGNSET NO - CONTINUE @VA03349 04103000
OI INTFLAG,NOPARM+WSEM INDICATE A PARM FIELD ERROR @VA03349 04104000
CL R6,LNKMAX GREATER THAN 8 CHAR? @VA03422 04105000
BNH FNDEND2 NO, USE THE FIELD LENGTH @VA03349 04106000
LA R6,8 USE THIS AS MAX LENGTH 04107000
FNDEND2 BAL R8,SGNERR GO QUEUE THE MESSAGE @VA03349 04108000
B SGNCALLA @VA04171 04109500
SPACE 1 04110000
SGNSET EQU * 04111000
LM R13,R15,SGNSETUP SETUP FOR SCAN 04112000
LA R8,SGNCALLA SET RETURN REGISTER @VA04171 04112500
SGNSCAN EQU * 04113000
CLC 0(4,R13),0(R3) IS THIS THE ONE? 04114000
BE SGNCALL YES 04115000
BXLE R13,R14,SGNSCAN AND CONTINUE THE SCAN 04116000
BAL R8,SGNERR GO QUEUE MESSAGE @VA03349 04117000
B SGNCALLA CONTINUE SCAN @VA04171 04118500
SPACE 04119000
SGNERR EQU * 04120000
ST R1,SGNERRS SAVE REGISTER @VA04171 04120200
OI INTFLAG,NOPARM+WSEM INDICATE A PARM ERROR @VA04171 04120400
LA R13,LINE GET LINE DEVICE BLOCK ADDRESS 04121000
BCTR R6,0 REDUCE BY ONE FOR MVC 04122000
EX R6,LNKMVC AND MOVE IN TO MSG 04123000
MSG 904,(SGNEPARM,AXSLINK) WRITE MSG 04124000
L R1,SGNERRS RESTORE REGISTER @VA04171 04125160
BR R8 RETURN TO CALLER @VA04171 04125320
SPACE 2 04125480
SGNERRS DC F'0' REGISTER ONE SAVE AREA @VA04171 04125640
SPACE 2 04125800
SGNERR2 EQU * @VA03420 04126000
TM INTFLAG,NOLINK LINKID VALID @VA05792 04126200
BNO LINKEXIT VALID - TEST OTHER ERRORS @VA05792 04126500
TM NPTFLAGS,MSGSEND SENDING A FILE? @VA03529 04132000
BZ NPTTERM NO, TERMINATE THE TASK @VA03529 04133000
LA R2,RDRBLK SET REQUEST BLOCK POINTER @VA03529 04134000
TM RDEVFLAG,FILACTIV ACTIVE FILE? @VA03529 04135000
BZ NPTTERM NO, GO TERMINATE TASK @VA03529 04136000
MVI RDEVSOPT,X'80' DO NOT PURGE COPY OR FILE @VA03529 04137000
BAL R14,AXSPURGE DELETE SPOOL FILE BEING PROCESSD @VA03529 04138000
B NPTTERM TERMINATE THE TASK @VA03529 04139000
EJECT 04140000
SGNCALL EQU * 04141000
L R15,4(R13) GET THE CORRECT ROUTINE ADDR 04142000
LA R0,10 SET DEFAULT RECS FOR BUFFER SCAN 04143000
BALR R14,R15 AND EXAMINE THE PARM 04144000
SGNCALLA EQU * @VA04171 04144500
SLR R4,R3 CALCULATE LENGTH OF PARM 04145000
LA R3,1(R4,R3) GET THE NEXT PARM START 04146000
B FNDEND AND GO GET IT 04147000
SPACE 1 04148000
SGNTRY CLC 0(0,R13),0(R3) TO BE EXECUTED FROM ABOVE 04149000
SPACE 1 04150000
SGNM L R5,SCANTERM GET END OF SCAN @VA03349 04151000
SGNMBB CLI 0(R5),ETX END OF TEXT @VA03349 04152000
BE SGNMAA YES, MARK IT @VA03349 04153000
CLI 0(R5),ETB END OF BLOCK @VA03349 04154000
BE SGNMAB YES, READER EMPTY - GET EOT @VA03349 04155000
CLI 0(R5),IRS 2770 ENDING @VA03349 04156000
BNE SGNM1 NO, LOOK NO FURTHER @VA03349 04157000
LA R5,1(0,R5) OVER THE IRS @VA03349 04158000
B SGNMBB KEEP LOOKING @VA03349 04159000
SGNMAA OI PUTFLAGS,ETXREC INDICATE ETX RECEIVED @VA03349 04160000
SGNMAB XI RESP+1,X'11' SWITCH THE RESP @VA03349 04161000
MVC DEVSTART,=A(RECEIVE) @VA03349 04162000
SGNMA BAL R14,LINEIO DO IT @VA03349 04163000
TM DEVFLAGS,IOERR WAS IT SUCCESSFUL @VA03349 04164000
BO SGNMA NO, ERROR @VA03349 04165000
CLI LINEINB,NAK IS THE DEVICE READY @VA03349 04166000
BNE NAKNO YES, LOOK FOR EOT @VA03349 04167000
LA R0,2 TAKE TWO SECOND DELAY @VA03349 04168000
BAL R14,TDELAY @VA03349 04169000
NAKNO EQU * @VA03349 04170000
CLI LINEINB,EOT IT BETTER BE AN EOT @VA03349 04171000
BNE SGNMA NOT EOT, GO GET IT @VA03349 04172000
MVC EXPRESP(2),INITACK0 EOT ALWAYS STARTS SEQ OVER @VA03349 04173000
MVC RESP(2),INITACK0 @VA03349 04174000
SGNMB TM INTFLAG,WSEM SERIOUS SIGNON ERROR @VA03349 04175000
BO SGNM3 YES, GO HANDLE IT @VA03349 04176000
TM INTFLAG,WSM ANY MORE DATA IN BUFFER @VA03349 04177000
BZ NPTGET NO, GO LOOK FOR MORE WORK @VA03349 04178000
LA R5,LINEINB POINT AT BUFFER @VA03349 04179000
A R5,RCOUNT PLUS BYTES OF FIRST READ @VA03349 04180000
BCTR R5,0 GET ADDR OF LAST XMITTED BYTE@VA04942 04181500
L R7,SCANTERM GET END OF SIGNON SCAN @VA03349 04182000
CLC LINEINB(2),=AL1(DLE,STX) IS THIS TRANSPARENT? @VA04944 04182150
BNE SGNNT BRANCH IF NOT @VA04944 04182300
OI PUTFLAGS,TRANSP INDICATE TRANSPARENT @VA04944 04182450
TM DEVFEAT,REM2770 IS THIS 2770 TYPE? @VA04944 04182600
BO PUTBLOCK BRANCH IF YES, NO IRS @VA04944 04182750
SGNNT EQU * @VA04944 04182900
LA R7,1(0,R7) JUMP OVER THE TERMINATOR @VA03349 04183000
TM DEVFEAT,REM2770 2770 TYPE @VA03349 04184000
BO NODEC5 YES, NO BCC @VA03349 04185000
BCTR R5,0 ADJUST COUNT FOR BCC @VA03349 04186000
LA R7,1(0,R7) ADJUST POINTER FOR BCC @VA03349 04187000
NODEC5 CLI 0(R7),STX START OF TEXT @VA03349 04188000
BE DEC5 @VA03349 04189000
CLC 0(2,R7),=X'1002' TRANSPARENT @VA03349 04190000
BNE NOTSTX NO, WHAT IS IT @VA03349 04191000
LA R7,1(0,R7) @VA03349 04193000
DEC5 EQU * @VA04942 04195500
LA R7,1(0,R7) @VA03349 04196000
B PUTBLOCK GO PROCESS THE BUFFER @VA03349 04197000
NOTSTX TM PUTFLAGS,TRANSP @VA03349 04198000
BO NPTLNAK @VA03349 04199000
B PUTBLOCK @VA03349 04200000
SPACE 1 04201000
SGNM1 OI INTFLAG,WSM INDICATE MORE DATA IN BUFFER @VA03349 04202000
LA R14,LINEINB POINT AT BUFFER START @VA03349 04203000
A R14,RCOUNT PLUS BYTES READ @VA03349 04204000
BCTR R14,0 ADJUST TO LAST BYTE @VA03349 04205000
BCTR R14,0 PASS OVER BCC @VA04944 04205500
CLI 0(R14),ETX END OF TEXT RECEIVED @VA03349 04206000
BNE SGNMB REVERSE INT NECESSARY @VA03349 04207000
OI PUTFLAGS,ETXREC INDICATE ETX RECEIVED @VA03349 04208000
B SGNMB @VA03349 04209000
DORVI XI RESP+1,X'11' RVI IS A POSITIVE RESPONSE @VA03349 04210000
MVC DEVSTART,=A(RVIPROG) SET UP TO REVERSE INT @VA03349 04211000
BAL R14,LINEIO GO DO IT @VA03349 04212000
TM DEVFLAGS,IOERR ANY ERRORS @VA03349 04213000
BO DORVI YES, TRY A REPEAT @VA03349 04214000
CLI LINEINB,EOT IS IT END OF XMISSION @VA03349 04215000
BNE DORVI NO, GO GET THE EOT @VA03349 04216000
B SGNM3A @VA03349 04217000
SPACE 1 04218000
SGNM3 TM PUTFLAGS,ETXREC ETX RECEIVED @VA03349 04219000
BO SGNM3A YES, NO NEED TO STOP XMISSION @VA03349 04220000
B DORVI FORCE A STOP @VA03349 04221000
SGNM3A BAL R14,MSGPROC GO WRITE IT OURSELF @VA03349 04222000
NI INTFLAG,X'FF'-(WSEM+NOSIGN+NOLINK+NOPARM+NOPAS) @VA03349 04223000
TM NPTFLAGS,RENBL ARE WE RE-ENABLING @VA05792 04223075
BO NPTLINK YES, DO NOT RESET @VA05792 04223150
MVI PRTSEL,DC1 RESET THE 3770 PRT SELECTION @VA04171 04223200
MVI DEVFEAT,X'00' CLEAR AND FEATURES SET @VA04171 04223400
B NPTLINK START OVER @VA03349 04224000
EJECT 04225000
ENDSCAN EQU * 04226000
MVC SGNEPARM(8),FILL BLANK THE ERROR BUFFER 04227000
CLI NPTPASS,C' ' OKAY 04228000
BNE SPASSE ERROR..EXIT 04229000
ENDSCANA EQU * @VA04171 04229500
LA R13,LINE GET LINE DEVICE BLOCK ADDRESS 04230000
TM DEVFEAT,REM2780+REM2770+REM3780+REM3770 ANYTHING? 04231000
BM ENDSCAN1 YES - CONTINUE 04232000
MSG 907 PUT OUT MISSING TYPE PARM MSG @VA03420 04233000
OI INTFLAG,NOPARM+WSEM INDICATE PARM ERROR @VA04171 04234330
B SGNM @VA04171 04234660
SPACE 1 04235000
ENDSCAN1 EQU * 04236000
TM DEVFEAT,REM2780 IS THE REMOTE STATION A 2780? 04237000
BZ CK2770 NO - GO CONTINUE CHECK 04238000
CON27801 EQU * 04239000
LH R1,MAXPRINT SEE IF ANYTHING SPECIFIED @VA03426 04240000
LTR R1,R1 ANYTHING? @VA03426 04241000
BNZ CKBYTS SEE IF BUFFER SPECIFIED @VA03426 04242000
LA R1,121 SET DEFAULT @VA03426 04243000
STH R1,MAXPRINT LINESIZE FOR 2780 @VA03426 04244000
CKBYTS EQU * @VA03426 04245000
LH R2,MAXBYTS PUT IN REG.R2 THE BUFFER EXTENSION 04246000
LTR R2,R2 ANYTHING SPECIFIED? 04247000
BNZ LINKEXIT YES - EXIT 04248000
LA R1,170 OTHERWISE SET THE DEFAUL VALUE 04249000
STH R1,MAXBYTS AND GET IT 04250000
LA R1,2 ALSO FOR @VA05794 04251000
STH R1,MAXREC THE MAX NUM OF TRANSMITTIBLE RECORDS 04252000
STH R1,MAXREC1 AND ALSO HERE 04253000
B LINKEXIT AND EXIT 04254000
SPACE 04255000
CK2770 EQU * 04256000
LH R2,MAXPRINT GET THE SPECIFIED VALUE 04257000
LTR R2,R2 ANYTHING SPECIFIED? 04258000
BNZ CON27701 YES - CONTINUE 04259000
LA R1,121 OTHERWISE SET THE DEFAULT VALUE + CC 04260000
TM DEVFEAT,REM3770 IS IT A 3770? 04261000
BNO CK27700 NO 04262000
LA R1,133 SET MAX LINE LENGTH 04263000
CK27700 EQU * 04264000
STH R1,MAXPRINT AND GET IT 04265000
EJECT 04266000
CON27701 EQU * 04267000
LH R2,MAXBYTS BUFFER EXTENSION IN REG 2 04268000
LTR R2,R2 ANYTHING SPECIFIED? 04269000
BNZ LINKEXIT YES - EXIT 04270000
LA R1,128 OTHERWISE SET DEFAULT VALUE 04271000
TM DEVFEAT,REM3780 3780? 04272000
BZ CON27702 NO CONTINUE 04273000
LA R1,512 CHANGE THE DEF VALUE FOR THE 3780 04274000
B CON27703 AND CONTINUE 04275000
CON27702 EQU * 04276000
TM DEVFEAT,REM3770 IS IT A 3770? 04277000
BNO CON27703 NO CONTINUE 04278000
LA R1,256 SET DEFAULT FOR 3770 04279000
CON27703 EQU * 04280000
STH R1,MAXBYTS AND GET IT 04281000
LA R1,10 ALSO FOR THE MAX NUMBER 04282000
STH R1,MAXREC OF TRASMITTIBLE RECORD 04283000
STH R1,MAXREC1 IN A BLOCK 04284000
B LINKEXIT AND EXIT 04285000
EJECT 04286000
*---------------------------------------------------------------------* 04287000
* VALIDATE TERMINAL TYPE * 04288000
*---------------------------------------------------------------------* 04289000
SPACE 04290000
S2770 EQU * 04291000
NI DEVFEAT,255-REM2780-REM3770-REM3780 TURN OFF OTHERS 04292000
OI DEVFEAT,REM2770 SET 2770 DEVICE TYPE 04293000
MVC SYSTYPE(4),=C'2770' SET REMOTE SYSTEM TYPE @VM01105 04294000
BR R14 AND CONTINUE 04295000
SPACE 1 04296000
S2780 EQU * 04297000
NI DEVFEAT,255-REM2770-REM3770-REM3780 TURN OFF REST 04298000
OI DEVFEAT,REM2780 INDICATE 2780 DEVICE 04299000
MVC SYSTYPE(4),=C'2780' SET REMOTE SYSTEM TYPE @VM01105 04300000
BR R14 AND CONTINUE 04301000
SPACE 1 04302000
S3770 EQU * 04303000
NI DEVFEAT,255-REM2770-REM2780-REM3780 TURN OFF OTHERS 04304000
OI DEVFEAT,REM3770+REM2770 INDICATE 3770 & TREAT @VA03115 04305000
* LIKE 2770 04306000
MVC SYSTYPE(4),=C'3770' SET REMOTE SYSTEM TYPE @VM01105 04307000
BR R14 AND CONTINUE 04308000
SPACE 1 04309000
S3780 EQU * 04310000
NI DEVFEAT,255-REM2770-REM2780-REM3770 TURN OFF OTHERS 04311000
OI DEVFEAT,REM3780+REM2770 INDICATE 3780 & TREAT @VA03115 04312000
* LIKE 2770 04313000
MVC SYSTYPE(4),=C'3780' SET REMOTE SYSTEM TYPE @VM01105 04314000
BR R14 AND CONTINUE 04315000
SPACE 1 04316000
*---------------------------------------------------------------------* 04317000
* VALIDATE BUFFER SIZE * 04318000
*---------------------------------------------------------------------* 04319000
SPACE 04320000
SB128 EQU * 04321000
TM DEVFEAT,REM2770 IS IT A 2770 DEVICE 04322000
BNO SGNERR NO ..ILLEGAL BUFFER IF SO 04323000
LA R1,128 SET DEFAULT BUFFER SIZE @VA03426 04324000
B SBCOMM ENTER COMMON BUFFER CODE 04325000
SPACE 1 04326000
SB170 EQU * 04327000
TM DEVFEAT,REM2780 IS IT A 2780 DEVICE? 04328000
BNO SGNERR NO..ILLEGAL BUFFER IF SO 04329000
LA R0,2 SET MAX RECORDS 04330000
LA R1,170 SET DEFAULT BUFFER SIZE @VA03426 04331000
B SBCOMM AND ENTER COMMON BUFFER CODE 04332000
SPACE 04333000
SB256 EQU * 04334000
TM DEVFEAT,REM2770+REM3770 IS IT A LEGAL BUFFER SIZE? 04335000
BZ SGNERR NO 04336000
LA R1,256 SET DEFAULT BUFFER SIZE @VA03426 04337000
B SBCOMM AND ENTER COMMON BUFFER CODE 04338000
EJECT 04339000
SB400 EQU * 04340000
TM DEVFEAT,REM2780 IS IT A 2780 DEVICE? 04341000
BNO SGNERR NO..ILLEGAL BUFFER SIZE 04342000
LA R1,400 SET DEFAULT BUFFER SIZE @VA03426 04343000
LA R0,3 AND THE MAX RECS 04344000
B SBCOMM ENTER COMMON BUFFER CODE 04345000
SPACE 1 04346000
SB512 EQU * 04347000
TM DEVFEAT,REM2770+REM3780 LEGAL BUFFER SIZE @VA03424 04348000
BZ SGNERR NO...ERROR EXIT 04349000
LA R1,512 SET DEFAULT BUFFER SIZE @VA03426 04350000
SBCOMM EQU * 04351000
STH R1,MAXBYTS STORE FOR LATER 04352000
STH R0,MAXREC SAVE MAX RECS 04353000
STH R0,MAXREC1 HERE TOO 04354000
BR R14 AND CONTINUE 04355000
SPACE 1 04356000
*---------------------------------------------------------------------* 04357000
* VALIDATE OTHER PARMS * 04358000
*---------------------------------------------------------------------* 04359000
SPACE 04360000
SCMPR EQU * 04361000
TM DEVFEAT,REM2770+REM3770+REM3780 CAN USE HERE? 04362000
BZ SGNERR NO 04363000
OI DEVFEAT,BLKCOMP SET BLANK COMPRESSION 04364000
BR R14 AND CONTINUE 04365000
SPACE 1 04366000
STRSY EQU * 04367000
OI DEVFEAT,TRANSP INDICATE TRANSPARENCY 04368000
BR R14 AND CONTINUE 04369000
SPACE 1 04370000
STRSN EQU * 04371000
NI DEVFEAT,255-TRANSP TURN OFF TRANSPARENCY 04372000
BR R14 AND CONTINUE 04373000
SPACE 1 04374000
SPCHY EQU * 04375000
OI DEVFEAT,REMPUNCH INDICATE REMOTE PUNCH PRESENT 04376000
BR R14 AND CONTINUE 04377000
SPACE 1 04378000
SPCHN EQU * 04379000
NI DEVFEAT,255-REMPUNCH INDICATE NO REMOTE PUNCH 04380000
BR R14 AND CONTINUE 04381000
SPACE 1 04381100
SLPRT EQU * @VA04171 04381200
TM DEVFEAT,REM3770 IS IT A 3770 @VA04171 04381300
BZ SGNERR NO, LINE PRINTER INVALID @VA04171 04381400
MVI PRTSEL,DC3 SET SELECTION TO LINE PRINTER @VA04171 04381500
BR R14 @VA04171 04381600
EJECT 04382000
*---------------------------------------------------------------------* 04383000
* VALIDATE MAXIMUM PRINT LINE SIZE * 04384000
*---------------------------------------------------------------------* 04385000
SPACE 04386000
SP120 EQU * 04387000
TM DEVFEAT,REM3770 THIS SIZE INVALID FOR 3770 @VA03426 04388000
BO SGNERR @VA03426 04389000
LA R1,121 INDICATE LENGTH OF PRINT LINE + CC 04390000
B SPCOMM ENTER COMMON CODE 04391000
SPACE 1 04392000
SP132 EQU * 04393000
TM DEVFEAT,REM2780+REM3780 INVAL FOR 2780 AND 3780 @VA03426 04394000
BNZ SGNERR @VA03426 04395000
LA R1,133 INDICATE LENGTH OF PRINT LINE + CC 04396000
B SPCOMM ENTER COMMON CODE 04397000
SPACE 1 04398000
SP144 EQU * 04399000
TM DEVFEAT,REM3770 THIS SIZE INVALID FOR 3770 @VA03426 04400000
BO SGNERR @VA03426 04401000
LA R1,145 INDICATE LENGTH OF PRINT LINE + CC 04402000
SPCOMM EQU * 04403000
STH R1,MAXPRINT STORE MAXIMUM PRINT LINE LENGTH 04404000
BR R14 AND CONTINUE 04405000
SPACE 1 04406000
*---------------------------------------------------------------------* 04407000
* VALIDATE PASSWORD * 04408000
*---------------------------------------------------------------------* 04409000
SPACE 04410000
SPASS EQU * 04411000
CLI NPTPASS,X'40' WAS A PASSWORD SPECIFIED 04412000
BER R14 NO RETURN 04413000
LA R3,1(R4) START OF NEXT PARM 04414000
BAL R14,PARMGET FRAME IT 04415000
CLR R3,R5 WAS IT THERE? 04416000
BNL SPASSE NO ERROR 04417000
SLR R4,R3 COMPUTE LENGTH 04418000
CL R4,LNKMAX IS THE PASSWORD TOO LONG? @VA03421 04419000
BNH SPASS1 NO...CONTINUE @VA03421 04420000
B SPASSE YES... WRITE THE ERROR MSG @VA03421 04421000
SPACE 04422000
SPASS1 EQU * @VA03421 04423000
BCTR R4,0 DOWN BY ONE FOR CHAR OP 04424000
EX R4,PASSMVC MOVE TO STAGING AREA 04425000
CLC NPTPASS(8),SGNEPARM VALIDATE PASSWORD 04426000
BNE SPASSE EVERY THING FINE 04427000
MVC NPTPASS(8),FILL BLANK THE PASSWORD FIELD 04428000
B ENDSCANA ALL DONE @VA04171 04429500
SPACE 1 04430000
SPASSE EQU * 04431000
OI INTFLAG,WSEM+NOPAS INDICATE A SIGNON ERROR MSG @VA03349 04432000
MSG 903,AXSLINK WRITE MSG @VA03421 04433000
B ENDSCANA GO WRITE ANY NECESSARY MSGS @VA04171 04434500
SPACE 04435000
PASSMVC MVC SGNEPARM(0),0(R3) TO BE EXECUTED FROM ABOVE 04436000
EJECT 04437000
LINKEXIT EQU * 04438000
TM INTFLAG,NOLINK+NOPARM+NOPAS ANY ERRORS @VA04171 04439100
BNZ SGNM YES, NO SIGNON COMPLETE @VA04171 04440100
MSG 905,AXSLINK WRITE THE MSG 04449000
TM NPTFLAGS,MSGSEND SENDING A FILE? @VA10178 04449110
BO NRESET YES, DO NOT RESET @VA10178 04449210
NI NPTFLAGS,X'FF'-RENBL RESET RE-ENABLE BIT @VA10178 04449310
NRESET EQU * @VA10178 04449410
OI INTFLAG,SIGNONED INDICATED WE HAVE SIGNONED 04451000
B SGNM GO DO THE SIGNON MESSAGES @VA03349 04452000
EJECT 04453000
*---------------------------------------------------------------------* 04454000
* * 04455000
* SIGNON CARD SCAN ROUTINE DATA AREA * 04456000
* * 04457000
*---------------------------------------------------------------------* 04458000
SPACE 1 04459000
SGNSETUP DC A(SGNTABLE) TABLE ADDR 04460000
DC A(SGNINC) TABLE INCREMENT 04461000
DC A(SGNEND-SGNINC) BEGINNING OF LAST ENTRY 04462000
SPACE 1 04463000
SGNINC EQU 8 LENGTH OF TABLE ENTRY 04464000
SPACE 1 04465000
SGNMAX DC F'4' MAXIMUM KEYWORD LENGTH 04466000
LNKMAX DC F'8' MAXIMUM LINKID LENGTH 04467000
SPACE 1 04468000
SGNEPARM DC CL8' ' ERROR PARAMETER 04469000
SPACE 1 04470000
SGNTABLE DC 0F'0' 04471000
DC CL4'2770',A(S2770) 2770 TERMINAL 04472000
DC CL4'2780',A(S2780) 2780 TERMINAL 04473000
DC CL4'3780',A(S3780) 3780 TERMINAL 04474000
DC CL4'3770',A(S3770) 3770 TERMINAL 04475000
DC CL4'B128',A(SB128) 128 BYTE BUFFER 04476000
DC CL4'B170',A(SB170) 170 BYTE BUFFER 04477000
DC CL4'B256',A(SB256) 256 BYTE BUFFER 04478000
DC CL4'B400',A(SB400) 400 BYTE BUFFER 04479000
DC CL4'B512',A(SB512) 512 BYTE BUFFER 04480000
DC CL4'CMPR',A(SCMPR) BLANK COMPRESSION 04481000
DC CL4'P120',A(SP120) 120 BYTE PRINT LENGTH 04482000
DC CL4'P132',A(SP132) 132 BYTE PRINT LENGTH 04483000
DC CL4'P144',A(SP144) 144 BYTE PRINT LENGTH 04484000
DC CL4'TRSY',A(STRSY) TRANSPARENCY 04485000
DC CL4'TRSN',A(STRSN) NO TRANSPARENCY 04486000
DC CL4'PCHY',A(SPCHY) REMOTE PUNCH PRESENT 04487000
DC CL4'PCHN',A(SPCHN) NO REMOTE PUNCH PRESENT 04488000
DC CL4'PWD=',A(SPASS) PASSWORD 04489000
DC CL4'LPRT',A(SLPRT) 3770 LINE PRINTER @VA04171 04489500
SGNEND EQU * 04490000
EJECT 04491000
LINEDROP EQU * 04492000
OI NPTFLAGS,RENBL SET RE ENABLE ON LINE DROP @VA05792 04492500
MSG 143,(AXSLINK,NPTLINE) 04493000
TM NPTFLAGS,MSGREC RECEIVING FILE? 04494000
BNO NPTENABL NO - GO TO ENABLE LINE 04495000
SPACE 2 04496000
LA R2,PUNBLK SET REQUEST BLOCK POINTER 04497000
L R13,RDEVFIOA SE DEV POINTER @VA05662 04498100
TM RDEVFLAG,FILEOPEN FILE OPEN? 04499000
BZ NPTENABL NO CONTINUE 04500000
UNPK CMDBUF+5(5),DEVADDR(3) UNPACK DEV ADDRESS @VA05662 04500100
MVI CMDBUF+5,C' ' CLEAR CLOBBERED BYTES @VA05662 04500200
MVI CMDBUF+9,C' ' @VA05662 04500300
TR CMDBUF+6(3),AXSTRTAB-240 TRANSLATE TO EBCDIC @VA05662 04500400
LA R0,CMDBUF ADDRESS OF TAG COMMAND @VA05662 04500500
LA R1,80 LENGHT @VA05662 04500600
DIAG R0,R1,8 ISSUE TAG COMMAND @VA05662 04500700
XC RDEVSYNC(4),RDEVSYNC CLEAR SYNCH LOCK 04501000
MVI RDEVFUN,X'12' CLOSE REQUEST CODE 04502000
LA R1,PUNBLK GET THE PUNCH BLOCK ADDR 04503000
L R15,GIVEREQ SYSTEM GIVE INITIATE 04504000
BALR R14,R15 GO GIVE IT 04505000
L R15,WAITREQ SYSTEM WAIT REQUEST 04506000
BALR R14,R15 GO WAIT 04507000
MVI PUTFLAGS,X'00' RESET PUTFLAGS 04508000
MVI LINERROR,X'00' RESET LINERROR 04509000
NI RDEVFLAG,X'FF'-FILEON-FILEOPEN RESET FILE MSG 04510000
NI NPTFLAGS,X'FF'-MSGREC RESET RECEIVING FLAG 04511000
B NPTENABL AND RE-INITIALIZE FROM THE TOP 04512000
SPACE 2 04513000
EJECT 04514000
*. 04515000
* 04516000
* ENTRY NAME - 04517000
* 04518000
* NPTERROR 04519000
* 04520000
* FUNCTION - 04521000
* 04522000
* TO WRITE THE TERMINAL I/O ERROR MSG AND TERMINATE THE TASK 04523000
* 04524000
* CALLS TO OTHER ROUTINES - 04525000
* 04526000
* NONE 04527000
* 04528000
* OPERATION - 04529000
* 04530000
* 1. SET UP THE CCW ADDR TO CALL TO IOERRPRT. 04531000
* 04532000
* 2. ISSUE THE I/O ERROR MESSAGE 04533000
* 04534000
* 3. BRANCH TO NPTTERM TO TERMINATE THE TASK. 04535000
* 04536000
* RESPONSES - 04537000
* 04538000
* NONE 04539000
* 04540000
* ERROR MESSAGES - 04541000
* 04542000
* NONE 04543000
* 04544000
*. 04545000
SPACE 3 04546000
DS 0H 04547000
USING DEVTABLE,R13 GET DEVICE TABLE ADDRESSABILITY 04548000
NPTERROR EQU * 04549000
LA R13,LINE GET LINE DEVICE TABLE 04550000
L R1,DEVCSW LAST CCW ADDR 04551000
LA R1,0(0,R1) MAKE SURE NO SIO CODE @VA04355 04551500
S R1,=F'8' BACK UP EIGHT 04552000
BAL R14,IOERRPRT PRT THE I/O ERROR MESSAGE 04553000
B NPTTERM AND EXIT THE TASK 04554000
SPACE 1 04555000
NPTERR1 EQU * 04556000
LA R13,LINE GET LINE DEVICE TABLE 04557000
L R1,DEVCSW LAST CCW ADDR 04558000
LA R1,0(0,R1) MAKE SURE NO SIO CODE @VA04355 04558500
S R1,=F'8' BACK UP EIGHT 04559000
BAL R14,IOERRPRT PRT THE I/O ERROR MESSAGE 04560000
B LINEDIS2 AND EXIT THE TASK 04561000
EJECT 04562000
*---------------------------------------------------------------------* 04563000
* * 04564000
* IOERROR MESSAGE PRINT ROUTINE * 04565000
* * 04566000
* AT ENTRY: R1 --> TO FAILING CCW * 04567000
* * 04568000
* * 04569000
*---------------------------------------------------------------------* 04570000
SPACE 04571000
DS 0H 04572000
IOERRPRT EQU * 04573000
STM R13,R1,IOERRSV STORE REGS IN SAVE AREA 04574000
MVC IOERRLNE(8),NPTLINE STORE LINE ADDRESS IN MSG 04575000
UNPK IERRCSW1(9),DEVCSW(5) SPREAD THE CSW 04576000
UNPK IERRCSW2(9),DEVCSW+4(5) SPREAD THE CSW 04577000
TR IERRCSW1(16),AXSTRTAB-240 AND TRANSLATE TO HEX 04578000
MVC IERRSIO(1),DEVSIOCC MOVE IN STARTIO CONDITION CODE 04579000
OI IERRSIO,X'F0' AND MAKE PRINTABLE 04580000
UNPK IERRSENS(3),DEVSENSE(2) SPREAD THE DIGIT 04581000
MVI IERRSENS+2,C' ' RESTORE THE BLANK 04582000
TR IERRSENS(2),AXSTRTAB-240 AND TRANSLATE TO HEX 04583000
TM DEVSIOCC,X'02' ANYTHING BAD? 04584000
BO IOERRPR1 YES BYPASS CCW 04585000
C R1,DEVSTART TEST ADDR IN CSW @VA04355 04585200
BNL *+8 OK IF NOT LESS @VA04355 04585400
L R1,DEVSTART INVALID, DISPLAY 1ST CCW @VA04355 04585600
UNPK IERRCCW1(9),0(5,R1) UNPACK THE CCW INTO MSG 04586000
UNPK IERRCCW2(9),4(5,R1) UNPACK THE CCW INTO MSG 04587000
TR IERRCCW1(16),AXSTRTAB-240 AND TRANSLATE TO HEX 04588000
IOERRPR1 EQU * 04589000
LA R0,IOERMSGL GET THE MSG LENGTH 04590000
LA R1,IOERRMSG GET THE MSG ADDR 04591000
BAL R14,MSG AND WRITE IT 04592000
MVI IERRCCW1,C'0' MOVE IN ONE ZERO 04593000
MVC IERRCCW1+1(15),IERRCCW1 AND MOVE TO REST 04594000
LM R13,R1,IOERRSV RESTORE REGISTERS 04595000
BR R14 AND RETURN 04596000
SPACE 04597000
IOERRSV DS 5F SAVE AREA 04598000
IOERRMSG DC AL2(70),AL2(0) MSG NUMBER AND SPARE 04599000
IOERRLNE DC CL8' ' LINE ADDR 04600000
IERRSIO DC CL8' ' ADAPTER SIO COND CODE 04601000
IERRCSW1 DC CL8' ' ADAPTER CSW 04602000
IERRCSW2 DC CL8' ' PART 2 OF CSW 04603000
IERRSENS DC CL8' ' ADAPTER SENSE BYTE 04604000
IERRCCW1 DC CL8'00000000' ADAPTER FAILING CCW 04605000
IERRCCW2 DC CL8'00000000' PART 2 OF CCW 04606000
IOERMSGL EQU *-IOERRMSG LENGTH OF ERROR MSG 04607000
DC CL1' ' GARBAGE BYTE 04608000
EJECT 04609000
*---------------------------------------------------------------------* 04610000
* * 04611000
* * 04612000
* EVENT TRACING ROUTINE * 04613000
* * 04614000
* ENTRY: * 04615000
* * 04616000
* TRTRAN -- TO RECORD A LINE TRANSACTION * 04617000
* TRERR -- TO RECORD A LINE ERROR * 04618000
* TRTIMOT -- TO RECORD A TIMEOUT * 04619000
* * 04620000
* * 04621000
*---------------------------------------------------------------------* 04622000
SPACE 1 04623000
DROP R7 04624000
USING LINKTABL,R1 GET LINK TABLE ADDRESSABILITY 04625000
SPACE 1 04626000
DS 0H 04627000
TRTRAN EQU * 04628000
STM R14,R1,TRSAVE SAVE REGISTERS 04629000
L R1,NPTALINK GET LINK TABLE ADDR 04630000
TM LFLAG,LTRALL SHOULD WE BE DOING THIS? 04631000
BNO TREXIT NO -- TIME TO EXIT 04632000
LH R15,LTRNSCNT GET THE CURRENT COUNT 04633000
LA R15,1(,R15) UP BY ONE 04634000
STH R15,LTRNSCNT AND REPLACE IN COUNT FIELD 04635000
C R15,THRESHLD IS IT TIME TO PRINT? 04636000
BL TREXIT NO RETURN 04637000
B TRPRT GO PRINT THE MSG 04638000
SPACE 04639000
TRERR EQU * 04640000
STM R14,R1,TRSAVE SAVE REGISTERS 04641000
L R1,NPTALINK GET LINK TABLE ADDR 04642000
TM LFLAG,LTRALL+LTRERR SHOULD WE BE DOING THIS? 04643000
BZ TREXIT NO -- TIME TO EXIT 04644000
LH R15,LERRCNT GET THE CURRENT COUNT 04645000
LA R15,1(,R15) UP BY ONE 04646000
STH R15,LERRCNT AND REPLACE IN COUNT FIELD 04647000
C R15,THRESHLD IS IT TIME TO PRINT? 04648000
BL TREXIT NO RETURN 04649000
B TRPRT GO PRINT THE MSG 04650000
SPACE 04651000
TRTIMOT EQU * 04652000
STM R14,R1,TRSAVE SAVE REGISTERS 04653000
L R1,NPTALINK GET LINK TABLE ADDR 04654000
TM LFLAG,LTRALL+LTRERR SHOULD WE BE DOING THIS? 04655000
BZ TREXIT NO -- TIME TO EXIT 04656000
LH R15,LTOCNT GET THE CURRENT COUNT 04657000
LA R15,1(,R15) UP BY ONE 04658000
STH R15,LTOCNT AND REPLACE IN COUNT FIELD 04659000
C R15,THRESHLD IS IT TIME TO PRINT? 04660000
BL TREXIT NO RETURN 04661000
EJECT 04662000
TRPRT EQU * 04663000
MVC TRLINK(8),AXSLINK MOVE LINKID INTO MSG 04664000
LH R15,LTRNSCNT GET THE CURRENT COUNT 04665000
CVD R15,TRCVD CONVERT TO DECIMAL 04666000
UNPK TRMTRN,TRCVD SPREAD THE DIGITS 04667000
OI TRMTRN+7,X'F0' MAKE THE LAST ONE PRINTABLE 04668000
LH R15,LERRCNT GET THE CURRENT COUNT 04669000
CVD R15,TRCVD CONVERT TO DECIMAL 04670000
UNPK TRMERR,TRCVD SPREAD THE DIGITS 04671000
OI TRMERR+7,X'F0' MAKE THE LAST ONE PRINTABLE 04672000
LH R15,LTOCNT GET THE CURRENT COUNT 04673000
CVD R15,TRCVD CONVERT TO DECIMAL 04674000
UNPK TRMTO,TRCVD SPREAD THE DIGITS 04675000
OI TRMTO+7,X'F0' MAKE THE LAST ONE PRINTABLE 04676000
SR R15,R15 CLEAR OUT R15 04677000
STH R15,LTRNSCNT CLEAR THE COUNTER 04678000
STH R15,LERRCNT CLEAR THE COUNTER 04679000
STH R15,LTOCNT CLEAR THE COUNTER 04680000
LA R0,TRMSGL GET THE MSG LENGTH 04681000
LA R15,X'80' ROUTE TO RSCS 04682000
LA R1,TRMSG GET THE MSG ADDR 04683000
BAL R14,MSG AND WRITE OUT THE MSG 04684000
SPACE 04685000
TREXIT EQU * 04686000
LM R14,R1,TRSAVE RESTORE THE REGS 04687000
BR R14 AND RETURN 04688000
SPACE 04689000
TRCVD DS D CVD AREA 04690000
TRSAVE DS 4F SAVE AREA 04691000
SPACE 04692000
TRMSG DC AL2(149),AL2(0) NUMBER PLUS SPARE 04693000
TRLINK DC CL8' ' LINKID 04694000
TRMTRN DC CL8' ' TRANSACTION COUNT 04695000
TRMERR DC CL8' ' ERROR COUNT 04696000
TRMTO DC CL8' ' TIMEOUT COUNT 04697000
TRMSGL EQU *-TRMSG LENGTH OF MSG 04698000
SPACE 04699000
THRESHLD DC F'20' THRESHOLD LEVEL FOR MSG 04700000
EJECT 04701000
*---------------------------------------------------------------------* 04702000
* * 04703000
* LOG ROUTINE * 04704000
* * 04705000
*---------------------------------------------------------------------* 04706000
SPACE 3 04707000
DMTNPTA EQU * @VA03349 04708000
ORG DMTNPT+X'4000' @VA03349 04709000
USING KLOGIT,R15 @VA03349 04710000
KLOGIT STM R13,R5,KSAV SAVE REGISTERS @VA03349 04711000
LR R5,R15 SET BASE @VA03349 04712000
DROP R15 @VA03349 04713000
USING KLOGIT,R5 @VA03349 04714000
TM $LOGSW,LOGON IS LOGING SET ON? 04715000
BCR 14,R14 (BNO) NO LOGGING - EXIT @VA03489 04716000
TM $LOGSW,LOGOPEN IS THE LOG DEVICE OPEN? 04717000
BO LOGCONT YES CONTINUE 04718000
XC LOGBLK(4),LOGBLK CLEAR SYNCH LOCK 04719000
LA R1,LOGBLK GET LOG REQUEST BLOCK 04720000
MVI LOGGREQ+1,X'11' INDICATE OUTPUT OPEN 04721000
L R15,GIVEREQ GET SYSTEM GIVE EXECUTOR 04722000
BALR R14,R15 GO EXECUTE THE REQUEST 04723000
L R15,WAITREQ SYSTEM WAIT EXECUTOR 04724000
BALR R14,R15 AND WAIT 04725000
OI $LOGSW,LOGOPEN SET LOG OPEN 04726000
MVC LOGLINK(8),AXSLINK SET LINKID IN MSG 04727000
LA R1,LOGTIME GET BUFFER FOR DIAG 04728000
DIAG R1,R2,X'0C' GET TIME AND DATA FROM VM 04729000
MVC LOGDTIME(8),LOGTIME MOVE TO MSG 04730000
MVC LOGDTIME+9(8),LOGTIME+8 MOVE TO MSG 04731000
L R1,LOGFIOA GET FIOA ADDR 04732000
MVC DEVSTART-DEVTABLE(4,R1),=A(LOGHDCCW) MOVE CCW ADDR 04733000
BAL R14,LOGPRINT OUTPUT THE HEADER LINE @VA03273 04734000
MVC DEVSTART-DEVTABLE(4,R1),=A(LOGCCW) SET LOG WRITE@VA03273 04735000
SPACE 1 04736000
LOGCONT EQU * @VA03273 04737000
UNPK IOLINE+43(15),DEVCSW+1(8) UNPACK THE CSW @VA03273 04738000
TR IOLINE+43(14),KTAB-240 SET LEGAL EBCDIC @VA03273 04739000
MVI IOLINE+57,C' ' CLEAR GARBAGE CHAR @VA03273 04740000
TM DEVCSW+4,UC DID WE GET UNIT CHECK? @VA03489 04741000
BZ LOGNOSEN NO, SENSE DATA MEANINGLESS @VA03489 04742000
UNPK IOLINE+58(3),DEVSENSE(2) UNPACK SENSE BYTE @VA03273 04743000
TR IOLINE+58(2),KTAB-240 SET LEGAL EBCDIC @VA03273 04744000
MVI IOLINE+60,C' ' CLEAR GARBAGE CHAR @VA03273 04745000
SPACE 1 04746000
LOGNOSEN L R2,DEVSTART START OF CHANNEL PROGRAM @VA03489 04747000
LA R2,0(,R2) INSURE HI-ORDER BYTE IS CLEARED @VA03489 04748000
EJECT 04749000
LOGOP EQU * @VA03273 04750000
CLI 0(R2),X'03' IS IT A NOP @VA03349 04751000
BE LOGCHAIN YES, SKIP IT @VA03349 04752000
BAL R14,LOGENTER LOG THE WRITE @VA03273 04753000
SPACE 1 04754000
LOGCHAIN EQU * @VA03273 04755000
TM 4(R2),CC MORE TO GO? @VA03273 04756000
BNO LOGDONE NO - RETURN @VA03273 04757000
LA R2,8(R2) TO THE NEXT CCW @VA03273 04758000
MVI IOLINE+43,C' ' CLEAR THE FIRST BYTE ... @VA03273 04759000
MVC IOLINE+44(16),IOLINE+43 CLEAR CSW AND SENSE @VA03273 04760000
B LOGOP AND DO THE NEXT CCW @VA03273 04761000
SPACE 1 04762000
SPACE 1 04763000
LOGDONE EQU * @VA03273 04764000
LM R13,R5,KSAV RESTORE REGISTERS @VA03349 04765000
BR R14 AND RETURN TO CALLER @VA03489 04766000
SPACE 1 04767000
LOGENTER EQU * @VA03273 04768000
UNPK IOLINE+62(9),0(5,R2) CCW FIRST HALF @VA03273 04769000
UNPK IOLINE+70(9),4(5,R2) CCW SECOND HALF @VA03273 04770000
TR IOLINE+62(16),KTAB-240 TRANS ABCDEF @VA03273 04771000
MVI IOLINE+78,C' ' CLEAR GARBAGE BYTE @VA03273 04772000
SPACE 1 04773000
MVC IOLINE(2),DASH MOVE NO DATA INDICATOR @VA03489 04774000
SR R4,R4 CLEAR WORK REGISTER @VA03489 04775000
LH R1,6(,R2) GET BUFFER LENGTH @VA03489 04776000
ICM R4,B'0111',DEVCSW+1 GET ENDING CCW ADDRESS @VA03489 04777000
S R4,=F'8' BACK UP CSW FOR CURRENT @VA03489 04778000
BALR R15,0 INITIALIZE CALC SWITCH @VA03489 04779000
BM LOGBUFAD IF INVALID, USE CCW LENGTH @VA03489 04780000
CR R4,R2 IS THIS THE ENDING CCW? @VA03489 04781000
BALR R15,0 REMEMBER CALC OPERATION @VA03489 04782000
BNE LOGBUFAD IF NO, USE CCW LENGTH @VA03489 04783000
LH R0,DEVCSW+6 GET RESIDUAL BYTE COUNT @VA03489 04784000
SR R1,R0 CALCULATE BYTES TRANSFERRED @VA03489 04785000
BNP LOGNOSIG ZIP ... SORRY ABOUT THAT @VA03489 04786000
SPACE 1 04787000
LOGBUFAD EQU * @VA03489 04788000
ICM R3,B'0111',1(R2) GET BUFFER ADDRESS @VA03489 04789000
UNPK PACKWORK(15),0(8,R3) GET FIRST PORTION @VA03489 04790000
UNPK PACKWORK+14(15),7(8,R3) GET NEXT PORTION @VA03489 04791000
TR PACKWORK(28),KTAB-240 CLEAN UP HEX ZONES @VA03489 04792000
LR R4,R1 SAVE BUFFER LENGTH @VA03489 04793000
S R4,=F'14' MORE THAN 14 BYTES IN BUFFER? @VA03489 04794000
BP LOGGT14 IF YES, ALSO DO LAST PORTION @VA03489 04795000
LR R4,R1 GET ORIGINAL BUFFER LENGTH @VA03489 04796000
SLL R4,1 DOUBLE FOR MOVE @VA03489 04797000
BCTR R4,0 DECREMENT FOR EXECUTE @VA03489 04798000
EX R4,LOGPKMV MOVE DATA TO BUFFER @VA03489 04799000
B LOGNOSIG NO LAST PORTION @VA03489 04800000
LOGGT14 MVC IOLINE(28),PACKWORK MOVE 14 BYTES TO BUFFER @VA03489 04801000
S R1,=F'8' LESS 8 FOR END OF BUFFER @VA03489 04802000
SPM R15 DID WE CALC FOR LENGTH? @VA03489 04803000
BE LOGLASTB NO, DETERMINE END OF BUFFER @VA03489 04804000
LA R1,1(,R1) BUMP BYTE COUNT @VA03489 04805000
LOGLASTB LA R3,0(R1,R3) POINT TO SEGMENT OF BUFFER @VA03489 04806000
UNPK IOLINE+28(15),0(8,R3) GET LAST PORTION OF DATA @VA03489 04807000
TR IOLINE+30(12),KTAB-240 TRANSLATE HEX ZONES @VA03489 04808000
MVI IOLINE+42,C' ' SET BLANK AFTER BUFFER @VA03273 04809000
MVC IOLINE+28(2),DASH SEPARATE TWO PARTS OF BUFFER @VA03489 04810000
SPACE 1 04811000
LOGNOSIG LH R0,6(,R2) CCW COUNT @VA03489 04812000
SPACE 1 04813000
LOGPRINT EQU * @VA03273 04814000
LR R3,R14 SAVE RETURN ADDRESS @VA03273 04815000
L R1,LOGFIOA LOG OUTPUT TABLE ADDRESS @VA03273 04816000
XC 0(4,R1),0(R1) CLEAR SYNCH LOCK @VA03273 04817000
L R15,IOREQ I/O REQUEST ENTRY ADDRESS @VA03273 04818000
BALR R14,R15 OUTPUT THE LOG LINE @VA03273 04819000
L R15,WAITREQ WAIT REQUEST ENTRY ADDRESS @VA03273 04820000
BALR R14,R15 WAIT FOR COMPLETION @VA03273 04821000
MVC IOLINE,C' ' CLEAR THE ... @VA03489 04822000
MVC IOLINE+1(119),IOLINE ... PRINT BUFFER @VA03489 04823000
BR R3 RETURN TO LOG ROUTINE @VA03273 04824000
SPACE 1 04825000
LOGCLEAR MVC 1(0,R3),0(R3) EXECUTED TO CLEAR LOG BUFFER @VA03273 04826000
LOGPKMV MVC IOLINE(0),PACKWORK EXECUTED TO MOVE BUFFER DATA @VA03489 04827000
SPACE 1 04828000
DROP R1 @VA03273 04829000
KTAB DC C'0123456789ABCDEF' TRANSLATE TAB @VA03349 04830000
KSAV DC 9F'0' SAVE AREA @VA03349 04831000
DROP R5 @VA03349 04832000
ORG DMTNPTA @VA03349 04833000
EJECT 04834000
DASH DC CL2'--' SEPARATOR FOR DATA IN BUFFER @VA03489 04835000
PACKWORK DS CL30 WORK AREA FOR UNPACKING @VA03489 04836000
IOLINE DC CL120' ' LOG PRINT LINE 04837000
SPACE 1 04838000
$LOGSW DC X'00' LOG SWITCH 04839000
* BITS DEFINED IN $LOGSW 04840000
LOGON EQU X'80' LOGING SET ON 04841000
LOGOPEN EQU X'40' LOG DEVICE OPEN 04842000
SPACE 1 04843000
DS 0F 04844000
LOGBLK DC F'0' SYNCH LOCK 04845000
DC CL4'AXS ' FILE ACCESS TASK NAME 04846000
DC A(LOGGREQ) REQUEST BUFFER ADDR 04847000
DC AL1(19),AL3(LOGGREQ) RESPONSE BUFFER ADDR 04848000
LOGGREQ DC AL1(19,0,0,0) LENGTH,FUNCTION,SPARE,SUBCODE 04849000
DC A(LOGTAG) LOG TAG ADDRESS 04850000
LOGFIOA DC A(0) FILE I/O AREA ADDRESS 04851000
DC CL8' ' LINK ID 04852000
SPACE 1 04853000
LOGTAG DC 108CL1' ' LOG TAG 04854000
SPACE 1 04855000
DS 0D 04856000
LOGCCW CCW X'09',IOLINE,SILI,120 WRITE AND SPACE 1 04857000
LOGHDCCW CCW X'19',LOGHDLNE,SILI,LOGHDRLN WRITE AND SPACE 3 04858000
SPACE 1 04859000
LOGHDLNE DC CL3' ' HEADER LINE 04860000
DC C'D M T N P T LINE TRANSACTION LOG FOR LINK ' 04861000
LOGLINK DC CL8' ' 04862000
DC C' ON ' 04863000
LOGDTIME DC CL17' ' 04864000
LOGHDRLN EQU *-LOGHDLNE LENGTH OF HDR LINE 04865000
DS 0D 04866000
LOGTIME DC CL32' ' DIAG BUFFER 04867000
EJECT - LOG 04868000
*---------------------------------------------------------------------* 04869000
* * 04870000
* CLOSE LOG ROUTINE * 04871000
* * 04872000
*---------------------------------------------------------------------* 04873000
SPACE 1 04874000
DC 0H'0' 04875000
LOGCLOSE EQU * 04876000
STM R14,R1,LOGCLSAV SAVE REGISTERS 04877000
NI $LOGSW,255-LOGON-LOGOPEN RESET FLAGS 04878000
XC LOGBLK(4),LOGBLK CLEAR SYNCH LOCK 04879000
LA R1,LOGBLK GET LOG REQUEST BLOCK 04880000
MVI LOGGREQ+1,X'12' INDICATE OUTPUT OPEN 04881000
L R15,GIVEREQ GET SYSTEM GIVE EXECUTOR 04882000
BALR R14,R15 GO EXECUTE THE REQUEST 04883000
L R15,WAITREQ SYSTEM WAIT EXECUTOR 04884000
BALR R14,R15 AND WAIT 04885000
LM R14,R1,LOGCLSAV RESTORE REGISTERS 04886000
BR R14 AND RETURN @VA03520 04887000
SPACE 1 04888000
LOGCLSAV DS 4F SAVE AREA 04889000
EJECT 04890000
*---------------------------------------------------------------------* 04891000
* * 04892000
* CCW'S, PSW'S, ETC. FOR INITIALIZATION * 04893000
* * 04894000
*---------------------------------------------------------------------* 04895000
SPACE 04896000
DS 0D 04897000
ENABPROG CCW X'2F',0,CC+SILI,1 DISABLE IN CASE NOT HUNG UP 04898000
CCW X'23',NPTMODE,CC+SILI,1 SET 'ITB ' MODE 04899000
CCW X'27',0,SILI,1 ENABLE THE ADAPTER 04900000
QUITPROG CCW X'2F',0,SILI,1 DISABLE 04901000
SPACE 04902000
NPTMODE DC X'40' SET 2701 (OR 2703) IN 'ITB ' MODE 04903000
EJECT 04904000
*. 04905000
* 04906000
* ENTRY NAME - 04907000
* 04908000
* NPTTERM 04909000
* 04910000
* FUNCTION - 04911000
* 04912000
* TERMINATE NPT TASK 04913000
* 04914000
* CALLS TO OTHER ROUTINES - 04915000
* 04916000
* DMTREX - TO TERMINATE THE DMTNPT TASK 04917000
* 04918000
* OPERATION - 04919000
* 04920000
* 1. ISSUE MSG 143 04921000
* 04922000
* 2. ISSUE TERMINATE REQUEST TO DMTREX. 04923000
* 04924000
* 3. WAIT ON A NEVER TO BE POSTED SYNCH LOCK. 04925000
* 04926000
* RESPONSES - 04927000
* 04928000
* DMTNPT143I LINK 'LINKID' LINE 'VADDR' DISCONNECTED 04929000
* 04930000
* ERROR MESSAGES - 04931000
* 04932000
* NONE 04933000
* 04934000
*. 04935000
SPACE 3 04936000
DS 0H 04937000
NPTTERM EQU * 04938000
LINEDIS1 EQU * 04939000
L R7,NPTALINK GET LINK TABLE ADDRESS 04940000
LA R13,LINE SET THE PTR TO THE LINE DEVICE BLOCK 04941000
MVC DEVSTART(4),=A(QUITPROG) ISSUE DISABLE 04942000
BAL R14,LINEIO GO DISABLE THE LINE 04943000
TM DEVFLAGS,IOERR END IN ERROR? 04944000
BO LINEDIS1 YES --TRY AGAIN 04945000
LINEDIS2 EQU * 04946000
LA R2,RDRBLK READER DEVICE BLOCK @VA05662 04946020
TM RDEVFLAG,FILACTIV FILE OPEN ? @VA05662 04946040
BZ NOSEND NO, NOT SENDING FILE @VA05662 04946060
MVI RDEVSOPT,X'81' INDICATE KEEP, NOHOLD OPTION @VA05662 04946080
BAL R14,AXSPURGE CLOSE AND SAVE THE FILE @VA05662 04946100
NOSEND LA R2,PUNBLK PUNCH DEVICE BLOCK @VA05662 04946120
TM RDEVFLAG,FILEOPEN FILE OPEN ? @VA05662 04946140
BZ NORECV NO, NOT RECEIVING FILE @VA05662 04946160
L R13,RDEVFIOA IOBLOCK ADDRESS @VA05662 04946180
UNPK CMDBUF+5(5),DEVADDR(3) UNPACK DEV ADDRESS @VA05662 04946200
MVI CMDBUF+5,C' ' CLEAR CLOBBERED BYTES @VA05662 04946220
MVI CMDBUF+9,C' ' @VA05662 04946240
TR CMDBUF+6(3),AXSTRTAB-240 TRANSLATE TO EBCDIC @VA05662 04946260
LA R0,CMDBUF ADDRESS OF TAG COMMAND @VA05662 04946280
LA R1,80 LENGTH @VA05662 04946300
DIAG R0,R1,8 ISSUE TAG COMMAND @VA05662 04946320
SR R0,R0 CLEAR R0 TO INDICATE GIVE @VA05662 04946340
ST R0,RDEVSYNC CLEAR SYNCH LOCK ALSO @VA05662 04946360
MVI RDEVFUN,X'12' INDICATE CLOSE REQUEST @VA05662 04946380
LR R1,R2 DEVICE BLOCK IN R1 @VA05662 04946400
L R15,GIVEREQ SYSTEM GIVE RTN @VA05662 04946420
BALR R14,R15 GIVE CLOSE TO AXS @VA05662 04946440
L R15,WAITREQ SYSTEM WAIT RTN @VA05662 04946460
BALR R14,R15 WAIT FOR ACCEPTANCE @VA05662 04946480
NORECV EQU * @VA05662 04946500
BAL R14,LOGCLOSE INSURE LOG IS CLOSED @VA03520 04947000
MSG 143,(AXSLINK,NPTLINE) WRITE MSG 04948000
SPACE 04949000
TASKILL EQU * 04950000
LA R1,REQREX GET TERMINATE REQUEST BLOCK 04951000
SR R0,R0 INDICATE GIVE INITIATE 04952000
L R15,GIVEREQ SYSTEM GIVE PROCESSOR 04953000
BALR R14,R15 GO TERMINATE THE TASK 04954000
L R15,WAITREQ GET SYSTEM WAIT ROUTINE ADDR 04955000
LA R1,LONGWAIT GET EMPTY SYNCH LOCK 04956000
BALR R14,R15 WAIT A LONG TIME 04957000
SPACE 3 04958000
* 04959000
REQDEL DS 0F 04960000
DC AL1(1) REQ. LENGHT 04961000
DC X'03' REQ. CODE 04962000
SPACE 04963000
REQREX DC F'0' SYNCH LOCK 04964000
DC CL4'REX ' GOES TO REX 04965000
DC A(REQDEL) REQUEST BUFFER ADDR 04966000
DC A(0) NO RESPONSE 04967000
SPACE 04968000
LONGWAIT DC F'0' A VERY LONG WAIT 04969000
EJECT 04970000
SPACE 04971000
RETRYNUM EQU 20 NUMBER OF RETRY TO RECOVERY ERRORS 04972000
REPLYCNT EQU 3 NUM OF ENQ RETRY FOR INCORRECT ACK 04973000
WAITNUM EQU 40 NUM OF T.O. FOR IN DEV. NOT READY 04974000
TIMEOUT EQU X'01' TIMEOUT BIT IN SENSE BYTE 04975000
DATACK EQU X'0E' DATA CHECK, OVERRUN, LOST DATA @VA03349 04976000
SPACE 04977000
NPTFLAGS DC AL1(0) MAIN ROUTINE FLAGS 04978000
* BITS DEFINED IN NPTFLAGS 04979000
MSGSEND EQU X'80' SENDING FILE 04980000
MSGREC EQU X'40' RECEIVING FILE 04981000
NOTIMEO EQU X'20' SUPPRESS ORDINARY TIMEOUTS IN LINEIO 04982000
TDLY EQU X'10' INDICATES TIMER DELAY ACTIVE @VA03349 04983000
NOETX EQU X'08' NO ETX IN THE RECORD 04984000
HEADFLAG EQU X'04' SENDING HEADER 04985000
ETXSEND EQU X'02' SEND ETX FLAG @VA03640 04986000
RENBL EQU X'01' REENABLING 04987000
SPACE 04988000
* DEVFLAGS EQUATES 04989000
IOERR EQU X'80' I/O ERROR OCCURRED ON LAST CALL 04990000
EMPTY EQU X'40' OUTPUT READER IS EMPTY 04991000
NOSCAN EQU X'20' DO NOT SCAN FOR ID RECORD 04992000
FILEON EQU X'10' RECV FILE MSG ISSUED FOR THIS FILE 04993000
MSGON EQU X'08' ISSUE FILE SENT MSG ON NEXT REQ 04994000
FILACTIV EQU X'04' FILE ACTIVE 04995000
FILREADY EQU X'02' FILE READY 04996000
FILEOPEN EQU X'01' OUTPUT FILE OPEN FLAG 04997000
SPACE 04998000
GETFLAGS DC AL1(BUFEMPTY) SPOOL BLOCK GET ROUTINE FLAGS 04999000
* BITS DEFINED IN GETFLAGS 05000000
BUFEMPTY EQU X'80' SPOOL BUFFER HAS NO DATA TO BE SENT 05001000
PRNTSEND EQU X'40' SENDING PRINT FILE 05002000
EJECT EQU X'20' DO PAGE EJECT AT EOF @VA03640 05003000
MSGQUED EQU X'10' MSGS QUEUED 05004000
EOF EQU X'08' END OF FILE IN THE INPUT SPOOL FILE 05005000
FILLED EQU X'04' INPUT BUFFER FILLED 05006000
IMFLG EQU X'02' PROCESSING SKIP IMMED FLAG 05007000
IMCMD EQU X'01' IMMEDIATE CARRIAGE COMMAND 05008000
SPACE 05009000
PUTFLAGS DC AL1(0) RECEIVING FLAG 05010000
* BITS DEFINED IN PUTFLAGS 05011000
XFERFLG EQU X'80' XFER IN PROGRESS 05012000
NOXFER EQU X'40' XFER FAILED 05013000
*TRANSP EQU X'20' TRANSPARENCY ON 05014000
EOTREC EQU X'10' EOT RECEIVED 05015000
ETXREC EQU X'08' ETX RECEIVED @VA03119 05016000
NTRDY EQU X'04' TRANSMISSION INTERRUPTED @VA03119 05017000
SPACMP EQU X'02' SPACE COMPRESSION ON @VA03112 05018000
SPACE 1 05019000
DEVFEAT DC AL1(0) TERMINAL DEVICE FEATURES 05020000
* BITS DEFINED IN DEVFEAT 05021000
ERROR EQU X'80' ERROR IN THE SPECIFIED FEATURE 05022000
BLKCOMP EQU X'40' BLANK COMPRESSION FEATURE 05023000
*TRANSP EQU X'20' TRANSPARENCY FEATURE 05024000
REMPUNCH EQU X'10' PUNCH UNIT AVAILABLE 05025000
REM2780 EQU X'08' 2780 REMOTE STATION 05026000
REM2770 EQU X'04' 2770 REMOTE STATION 05027000
REM3780 EQU X'02' 3780 REMOTE STATION 05028000
REM3770 EQU X'01' 3770 REMOTE STATION 05029000
* NOTE: 3780 AND 3770 TERMINALS ALSO HAVE THE REM2770 BIT SET SINCE 05030000
* THESE THREE TERMINAL TYPES ARE TREATED IDENTICALLY. 05031000
EJECT 05032000
INTFLAG DC AL1(0) COMMAND ACTION FLAG 05033000
* BITS DEFINED IN INTFLAG 05034000
INTOUT EQU X'80' OUTPUT INTERRUPTED 05035000
SIGNONED EQU X'40' SIGNON CARD ACCEPTED 05036000
WSM EQU X'20' SIGNON HAS DATA FOLLOWING @VA03349 05037000
WSEM EQU X'10' WRITE SIGNON ERROR MSG PENDING @VA03349 05038000
NOSIGN EQU X'08' NOT A SIGNON CARD @VA03349 05039000
NOLINK EQU X'04' LINKID INVALID @VA03349 05040000
NOPARM EQU X'02' PARM FIELD IS INVALID @VA03349 05041000
NOPAS EQU X'01' PASSWORD IS INVALID @VA03349 05042000
SPACE 05043000
LINERROR DC AL1(0) ERRORS FLAGS 05044000
* BITS DEFINED IN LINERROR 05045000
OUTNRDY EQU X'80' OUTPUT DEVICE NOT READY 05046000
NOEXACK EQU X'40' INCORRECT REPLY RECEIVED 05047000
NAKEOT EQU X'20' EOT SENT AFTER A SERIES OF NAKS @VA03349 05048000
NAKREC EQU X'10' NAK RECEIVED 05049000
WACKREC EQU X'08' WACK RECEIVED @VA03341 05050000
CKRESP EQU X'02' REREAD OF LAST RESPONSE @VA03349 05051000
CTLMODE EQU X'01' DEVICE WENT TO CONTROL EARLY @VA03349 05052000
SPACE 2 05053000
SELFLAGS DC AL1(0) DEVICE SELECTION FLAGS @VA03349 05054000
PCHSEL EQU X'01' SELECTING THE PUNCH @VA03349 05055000
RSELECT EQU X'02' RESELECT AFTER OUTPUT INTERRUPT @VA03349 05056000
VCMD EQU X'80' VALID COMMAND ENTERED @VA04171 05056500
SPACE 05057000
* MULTI EQUATE 05058000
TRANSP EQU X'20' TRANSPARENCY ON 05059000
TRTFNCBT DC AL1(0) TRANSLATE FUNCTION BYTE @VA04942 05059100
SPACE 2 05060000
* LINE CONTROL CHARACTER EQUATES 05061000
SOH EQU X'01' START OF HEADER 05062000
STX EQU X'02' START OF TEXT 05063000
ETX EQU X'03' END OF TEXT 05064000
DLE EQU X'10' DATA-LINE ESCAPE 05065000
DC1 EQU X'11' DATA CONTROL ONE 05066000
DC2 EQU X'12' DATA CONTROL TWO 05067000
NL EQU X'15' NEW LINE @VA04949 05067100
EM EQU X'19' END OF MEDIA 05068000
IGS EQU X'1D' INTER GROUP SEPARATOR 05069000
IRS EQU X'1E' INTER RECORD SEPARATOR 05070000
ITB EQU X'1F' INTERMEDIATE TEXT BLOCK 05071000
ETB EQU X'26' END OF TRANSMISSION BLOCK 05072000
ESC EQU X'27' ESCAPE 05073000
ENQ EQU X'2D' ENQUIRY 05074000
SYN EQU X'32' SYNCHRONIZATION 05075000
EOT EQU X'37' END OF TRANSMISSION 05076000
NAK EQU X'3D' NEGATIVE ACKNOWLEDGEMENT 05077000
DC3 EQU X'5D' SELECT 3770 LINE PRINTER @VA04171 05077500
ACK1 EQU X'61' POSITIVE ACKNOWLEDGEMENT (ODD) 05078000
WABT EQU X'6B' WAIT BEFORE TRANSMIT 05079000
ACK0 EQU X'70' POSITIVE ACKNOWLEDGEMENT (EVEN) 05080000
EPAD EQU X'FF' ENDING PAD CHARACTER @VA03349 05081000
SPAD EQU X'AA' STARTING PAD CHARACTER @VA03349 05082000
RVI EQU X'7C' REVERSE INTERRUPT CHARACTER @VA03349 05083000
EJECT 05084000
LTORG 05085000
EJECT 05086000
COPY SVECTORS 05087000
EJECT 05088000
COPY TASKE 05089000
EJECT 05090000
COPY LINKTABL 05091000
EJECT 05092000
COPY TAG 05093000
EJECT 05094000
DEVTABLE DSECT 05095000
SPACE 1 05096000
*** DEVTABLE - DEVICE BLOCK 05097000
* 05098000
* 0 +-----------------------------------------------+ 05099000
* | DEVLOCK | 05100000
* 4 +-----------------------+-----------------------+ 05101000
* | DEVADDR | DEVSNREQ | DEVTYPE | 05102000
* 8 +-----------------------+-----------------------+ 05103000
* | DEVSTART | 05104000
* C +-----+-----------------------------------------+ 05105000
* | D*1 | | 05106000
* +-----+ | 05107000
* | DEVCSW | 05108000
* | | 05109000
* 14 +-----------+-----------------------------------+ 05110000
* | DEVSENSE | DEVFLAGS | 05111000
* 18 +-----------+-----------------------------------+ 05112000
* | | 05113000
* | DEVNAME | 05114000
* | | 05115000
* 20 +-----------------------------------------------+ 05116000
* 05117000
*** DEVTABLE - DEVICE BLOCK 05118000
SPACE 1 05119000
DEVLOCK DC F'0' I/O REQUEST SYNCH LOCK 05120000
DEVADDR DC AL2(0) CUU ADDRESS OF I/O DEVICE 05121000
DEVSNREQ DC AL1(0) REQUESTED SENSE BYTES 05122000
DEVTYPE DC X'00' VM/370 DEVICE TYPE CODE 05123000
DEVSTART DC F'0' ADDR START CHAN PROG FOR I/O HAND 05124000
DEVSIOCC DC 0X'00' D*1 RIGHT JUSTIFIED SIO CONDITION CODE 05125000
DEVCSW DC 2F'0' ENDING CSW FROM LAST I/O OPERATION 05126000
DEVSENSE DC X'00' SENSE INFORMATION ON UNIT CHECK 05127000
DEVFLAGS DC 3X'00' DEVICE STATUS FLAGS 05128000
DEVNAME DC CL8' ' EBCDIC DEV ADDRESS AND NAME 05129000
EJECT 05130000
REQBLOCK DSECT 05131000
SPACE 1 05132000
*** REQBLOCK - REQUEST BLOCK 05133000
* 05134000
* 0 +-----------------------------------------------+ 05135000
* | RDEVSYNC | 05136000
* 4 +-----------------------------------------------+ 05137000
* | RDEVREQN | 05138000
* 8 +-----------------------------------------------+ 05139000
* | RDEVREQ | 05140000
* C +-----------------------------------------------+ 05141000
* | RDEVRESP | 05142000
* 10 +-----------+-----------+-----------+-----------+ 05143000
* | RDEVRLEN | RDEVFUN | RDEVRESV | RDEVSOPT | 05144000
* 14 +-----------+-----------+-----------+-----------+ 05145000
* | RDEVTAG | 05146000
* 18 +-----------------------------------------------+ 05147000
* | RDEVFIOA | 05148000
* 1C +-----------------------------------------------+ 05149000
* | | 05150000
* | RDEVLINK | 05151000
* | | 05152000
* 24 +-----------------------------------------------+ 05153000
* | RDEVNAME | | 05154000
* +-----------------------------------+ | 05155000
* | RDEVSTYL | 05156000
* 2C +-----------------------------------------------+ 05157000
* | RDEVFLAGS | 05158000
* 30 +-----------------------------------------------+ 05159000
* 05160000
*** REQBLOCK - REQUEST BLOCK 05161000
SPACE 1 05162000
RDEVSYNC DC F'0' SYNCH LOCK 05163000
RDEVREQN DC CL4'AXS ' FILE ACCESS TASK 05164000
RDEVREQ DC A(0) REQUEST BUFFER ADDR 05165000
RDEVRESP DC AL1(0),AL3(0) RESPONSE BUFFER 05166000
RDEVRLEN DC AL1(0) REQUEST LENGTH 05167000
RDEVFUN DC AL1(0) REQUEST FUNCTION 05168000
RDEVRESV DC AL1(0) RESERVED BYTE 05169000
RDEVSOPT DC AL1(0) SUB OPTION BYTE 05170000
RDEVTAG DC A(0) TAG ADDRESS 05171000
RDEVFIOA DC A(0) FILE I/O AREA 05172000
RDEVLINK DC CL8' ' LINK NAME 05173000
RDEVNAME DC C' ' DEVICE STYLE 05174000
RDEVSTYL DC C' ' 05175000
RDEVFLAG DC AL1(0,0,0,0) DEVICE FLAGS 05176000
EJECT 05177000
COPY RSSEQU 05178000
EJECT 05179000
COPY DEVTYPES 05180000
EJECT 05181000
COPY SPOOL 05182000
END 05183000