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