./ ADD SSI=21390265,NAME=IHKABALC,SOURCE=0 ALCE TITLE 'IHKABALC - SYSIN ALLOCATION' 00200018 IHKABALC CSECT 00400018 * 006000-016000,044000-049000,196000,370000,374000,606000-614000 19018 01100019 *0793306000,480000-488000,600000 000B 01800018 *2220040000,310000,352000,552000 0576 02000018 *2220030000,192000,304000,346000,390000,536000 000C 02200018 *2220042000,546000-548000 1655 02400018 *C 046000,584000 A35909 02450021 *A 350000 A44704 02500021 *D 348000-352000,474000-476000 A44704 02550021 *C 045000,358000,588000,590000,594000 A44704 02600021 * * 02650021 * STATUS - CHANGE LEVEL 2, RELEASE 21.6 02700021 * * 02800018 *FUNCTION/OPERATION - THE BASIC FUNCTIONS OF THIS ROUTINE ARE * 03000018 * 1. ALLOCATE A DATA SET FOR SYSIN DATA * 03200018 * 2. MODIFY THE DD * OR DD DATA CARD TO POINT TO THE SYSIN DATA SET * 03400018 * 3. OPEN THE SYSIN DATA SET. * 03600018 * * 03800018 * A SEQUENTIAL DATA SET IS ALLOCATED FOR THE SYSIN DATA USING THE * 04000018 * DADSM ALLOCATE ROUTINE - SVC 32. THE DD * OR DD DATA CARD IS * 04200018 * CHANGED TO THE FOLLOWING CARDS: 19018 04300019 * 19018 04400019 * //DDNAME DD UNIT=XXXX,DISP=(OLD,DELETE),VOLUME=SER=XXXXXX, X A44704 04500021 * // DSNAME=SYSXXXXX.T123456.IV007,JOBNAME.SXXXXXXX, X A35909 04600021 * // SPACE=(80,(XXXXXX)) 19018 04700019 * * 05000018 *ENTRY POINT - * 05200018 * IHKABALC - TO ALLOCATE A SYSIN DATA SET. * 05400018 * CALLING SEQUENCE - LA 1,PARAM * 05600018 * LA 13,SAVE AREA FOR THIS LINE * 05800018 * L 15,=V(IHKABALC) * 06000018 * BALR 14,15 * 06200018 * WHERE PARAM IS A WORD CONTAINING THE LCB ADDRESS * 06400018 * * 06600018 *INPUT - AS DESCRIBED ABOVE AND * 06800018 * LCBPARM1 IN THE LCB MUST CONTAIN THE JECL-JCL BUFFER INDEX * 07000018 * * 07200018 *OUTPUT - THE OPEN SYSIN DATA SET IS ON DISK, AND THE MODIFIED DD * OR* 07400018 * DD DATA CARDS ARE ON SYS1.SYSJOBQE. * 07600018 * * 07800018 *EXTERNAL ROUTINES - * 08000018 * IHKQMNGR - TO INTERFACE WITH IEFQMSSS 000A 08200018 * IGC0003B - DADSM ALLOCATE TO ALLOCATE SPACE FOR A SYSIN * 08400018 * DATA SET. * 08600018 * OPENJ - TO OPEN A SYSIN DATA SET. * 08800018 * * 09000018 *EXITS - NORMAL - RETURN IS MADE TO LINE ANALYSIS READ WITH A RETURN * 09200018 * CODE OF ZERO IN REGISTER 15. * 09400018 * * 09600018 *EXITS - ERROR - RETURN IS MADE TO LINE ANALYSIS READ WITH A RETURN * 09800018 * CODE IN REGISTER 15 AS FOLLOWS * 10000018 * 4 - I/O ERROR ON OS QUEUE MANAGER WRITE * 10200018 * 8 - OUT OF SPACE ON DISK * 10400018 * 12 - I/O ERROR WHILE ALLOCATING SYSIN DATA SET. * 10600018 * * 10800018 * LINE ANALYSIS READ CALLS IHKABXMT TO WRITE THE PROPER ERROR 000A 11000018 * MESSAGE. 000A 11200018 * 000B 11400018 * ABNORMAL CENTRAL CLOSEDOWN IS INITIATED WHEN AN UNRECOVERABLE 000B 11600018 * ERROR IS ENCOUNTERED. 000B 11800018 * * 12000018 *TABLES/WORK AREA - THE LINE CONTROL BLOCK (LCB), 452-BYTE DISK * 12200018 * BUFFER, 18-WORD REGISTER SAVE AREA, DISK DCB, BTAM BUFFER AND * 12400018 * CONSTANT AREA OF LINE ANALYSIS READ ARE USED. * 12600018 * * 12800018 *ATTRIBUTES - IT IS REENTRANT. 000A 13000018 * * 13200018 *NOTES - THE OPERATION OF THIS SUBROUTINE DEPENDS UPON AN INTERNAL * 13400018 * REPRESENTATION OF THE EXTERNAL CHARACTER SET WHICH IS EQUIVALENT * 13600018 * TO THE ONE USED AT ASSEMBLY TIME. THE CODING HAS BEEN ARRANGED SO* 13800018 * THAT REDEFINITION OF CHARACTER-TYPE CONSTANTS, BY REASSEMBLY, WILL* 14000018 * RESULT IN AN CORRECT MODULE FOR THE NEW DEFINITION. * 14200018 SPACE 2 14400018 R0 EQU 0 14600018 R1 EQU 1 QUEUE MANAGER PARAM. AREA POINTER 14800018 R2 EQU 2 LCB POINTER 15000018 R3 EQU 3 JECL-JCL BUFFER POINTER 15200018 R4 EQU 4 JECL-JCL BUFFER INDEX - 0 OR 80 15400018 R5 EQU 5 BTAM BUFFER POINTER 15600018 R6 EQU 6 (END OF BTAM BUFFER POINTER) 15800018 R7 EQU 7 DISK DECB POINTER 16000018 R8 EQU 8 DISK DCB POINTER 16200018 R9 EQU 9 VARIABLE - BASE OF JFCB DSECT 16400018 R10 EQU 10 VARIABLE - BASE OF UCB DSECT 16600018 R11 EQU 11 BASE OF CONSTANT DSECT 16800018 R12 EQU 12 BASE REGISTER 17000018 R13 EQU 13 SAVE AREA POINTER 17200018 R14 EQU 14 RETURN REGISTER 17400018 R15 EQU 15 ENTRY POINT REGISTER 17600018 SPACE 17800018 EXTRN IHKABCON CONSTANT AREA IN IHKABLRD 18000018 SPACE 18200018 USING IOPARAMS,R1 18400018 USING LCBDSECT,R2 18600018 USING IECTDECB,R7 18800018 USING IHADCB,R8 19000018 USING LRDJFCBN,R9 19200018 USING LRDUCBOB,R10 19400018 USING LRDSPENT,R11 19018 19600019 USING LRDCVT,R14 19800018 USING *,R15 USE REG. 15 AS TEMPORARY BASE 000A 20000018 B LRDSKIP 000A 20200018 DC C'IHKABALC' 000A 20400018 LRDSKIP DS 0H 000A 20600018 DROP R15 000A 20800018 L R2,0(R1) GET LCB ADDRESS 000A 21000018 L R1,LCBBUFER GET QMPA ADDRESS 000A 21200018 LA R3,QMCHN GET JECL-JCL BUFFER ADDRESS 000A 21400018 STM R12,R14,LRDSAVE(R3) SAVE REGISTERS 12,13,14 000A 21600018 BALR R12,0 ESTABLISH BASE 21800018 USING *,R12 22000018 L R4,LCBPARM1 GET JECL-JCL BUFFER INDEX 22200018 L R7,LCBDDECB GET DISK DECB POINTER FROM LCB 22400018 L R8,DECDCBAD GET DISK DCB POINTER 22600018 L R11,LRDABCON SET BASE FOR CONSTANT DSECT 22800018 LA R9,LRDSCDHF(R3) GET ADDRESS OF BUFFER AREA FOR JFCB 23000018 LA R1,LRDXLST(R3) GET ADDRESS OF AREA FOR EXLST 000A 23200018 MVC 4(4,R1),LRDEXLST MOVE SECOND WORD OF EXLST 000A 23400018 ST R9,0(R1) STORE ADDRESS FOR JFCB IN EXLST 000A 23600018 MVI 0(R1),LRDJFCB7 INDICATE EXLST ENTRY FOR JFCB 000A 23800018 ST R1,DCBEXLST POINT DCB TO MODIFIED EXLST 000A 24000018 MVI DCBEXLST,LRDFB RESET RECFM TO FB 000A 24200018 RDJFCB ((8)) GET JFCB FOR SYSIN DATA SETS 24400018 OI JFCBIND2,LRDNWDS INDICATE NEW DATA SET 24600018 L R14,CVTPTR GET ADDRESS OF CVT 000A 24800018 L R1,CVTDATE GET DATE IN PACKED DECIMAL 000A 25000018 ST R1,LRDDECNO STORE PACKED DECIMAL DATE 000A 25200018 UNPK LRDUPDEC(8),LRDDECNO(4) UNPACK DATE 000A 25400018 OI LRDUPDEC+7,LRDZONE CHANGE SIGN BITS TO ZONE BITS 000A 25600018 MVC JFCBDSNM(3),LRDSYS PUT 'SYS' IN DSNAME 000A 25800018 MVC JFCBDSNM+3(5),LRDUPDEC+3 PUT DATE IN DSNAME 000A 26000018 MVC JFCBDSNM+8(16),LRDPERT PUT'.T123456.R0007. ' IN 000A 26200018 MVC JFCBDSNM+24(20),JFCBDSNM+23 BLANK REST OF DSNAME 000A 26400018 LRDNEWDS L R10,LRDCNTR GET DSNAME COUNTER 26600018 LA R10,1(R10) STEP DSNAME COUNTER 26800018 ST R10,LRDCNTR SAVE DSNAME COUNTER 27000018 CVD R10,LRDDECNO CONVERT COUNTER TO PACKED DECIMAL 27200018 UNPK LRDUPDEC(8),LRDDECNO+4(4) UNPACK THE DECIMAL COUNTER 27400018 OI LRDUPDEC+7,LRDZONE CHANGE SIGN BITS TO ZONE BITS 27600018 L R1,LCBBUFER GET ADDRESS OF QMPA 000A 27800018 MVC JFCBDSNM+23(8),QMNAM PUT JOBNAME IN DSNAME 000A 28000018 LA R10,JFCBDSNM+23 GET ADDRESS OF JOBNAME 000A 28200018 AH R10,LRDJOBCH(R1) ADD LENGTH OF JOBNAME 000A 28400018 MVC 0(2,R10),LRDPERS PUT .S AFTER JOBNAME 28600018 MVC 2(7,R10),LRDUPDEC+1 PUT DSNAME NUMBER ON CARD 28800018 LR R0,R9 GET ADDRESS OF JFCB 29000018 L R1,LRDUCBAD GET ADDRESS OF UCB ADDRESS 29200018 SVC 32 CALL DADSM ALLOCATE ROUTINE IGC0003B 29400018 CH R15,LRDALRET CHECK RETURN CODE 000A 29600018 BH LRDSYSSP BRANCH IF NO SPACE AVAILABLE 29800018 B *+4(R15) BRANCH ON RETURN CODE 30000018 B LRDALOCD BRANCH ON SUCCESSFUL ALLOCATION 30200018 B LRDNEWDS BRANCH ON DUPLICATE NAME 30400018 B LRDSYSSP BRANCH ON NO ROOM IN VTOC 30600018 B LRDRETRN BRANCH ON I/O ERROR 30800018 SPACE 1 31000018 LRDALOCD L R10,LRDUCBAD GET ADDRESS OF UCB ADDRESS 31200018 L R10,0(R10) GET UCB ADDRESS 31400018 MVC VOLUME(6),SRTEVOLI PUT VOLUME SERIAL ON CARD 0576 31600018 CLI UCBTBYT3,UCB3DACC TEST FOR DIRECT ACCESS DEVICE 31800018 * BAD RJE PROCEDURE 000B 32000018 * UNIT ON LINE SYSIN DD CARD IS BA000B 32200018 BE ROLLON 000B 32400018 USING IHKZZAVT,R14 000B 32600018 L R14,LRDZZAVT 000B 32800018 L R1,IHKZZRCS 000B 33000018 OI 0(R1),HANGITUP 000B 33200018 HANGITUP EQU X'03' 000B 33400018 L R15,IHKZZASE 000B 33600018 BR R15 000B 33800018 ROLLON DS 0H 000B 34000018 USING LRDCVT,R14 000B 34200018 SR R1,R1 CLEAR REGISTER 34400018 IC R1,UCBTBYT4 GET UNIT TYPE CODE FROM UCB 34600018 SLL R1,2 MULTIPLY BY 4 A44704 35000021 LA R0,LRDUNITS GET ADDRESS OF UNIT CHARACTERS 35400018 AR R1,R0 INDEX TO PROPER CHARACTERS 35600018 MVC UNITNO(4),0(R1) PLACE UNIT # IN SYSIN DD A44704 35800021 LR R10,R3 GET ADDRESS OF JECL AND JCL BUFFER 36000018 AR R10,R4 ADD BUFFER INDEX (0 OR 80) 36200018 MVC 25(51,R10),LRDDDCD1 REPLACE COLUMNS 22-72 36400018 LA R9,ALCOM SET RETURN ADDRESS 19018 36500019 LA R10,66(R10) GET ADDRESS OF VOLUME SERIAL 0576 36600018 STEP LA R10,1(R10) STEP TO NEXT BYTE 0576 36800018 CLI 0(R10),ALCBLANK IS IT BLANK? A20576 37000019 BNE STEP NO, KEEP TRYING 0576 37200018 MVI 0(R10),ALCCOMMA REPLACE BLANK WITH COMMA A20576 37300019 BR R9 RETURN 19018 37400019 ALCOM DS 0H 19018 37500019 X R4,LRDDEC80 SET JCL BUFFER INDEX TO 80 OR 0 37600018 STC R4,LRDCDIND(R3) TO INDICATE 1 OR 2 CARDS IN BUFFER 37800018 * (80 MEANS 1 CARD, 0 MEANS 2 CARDS) 38000018 BC 4,LRDNOWRT BRANCH IF BUFFER NOT FULL (INDEX=80) 38200018 BAL R10,LRDWRASG WRITE BUFFER AND ASSIGN NEXT TTR 38400018 LRDNOWRT LR R10,R3 GET ADDRESS OF JECL AND JCL BUFFER 38600018 AR R10,R4 ADD BUFFER INDEX (0 OR 80) 38800018 MVC 4(3,R10),LRDSLASH PUT // BLANK IN COLS. 1-3 39000018 MVC 7(12,R10),6(R10) PUT BLANKS IN COLS. 4-15 39200018 LA R9,LRDSCDHF(R3) GET ADDRESS OF JFCB 000A 39400018 MVC 19(7,R10),LRDDSNAM PUT 'DSNAME=' IN COLS. 16-22 000A 39600018 MVC 26(44,R10),JFCBDSNM PUT DSNAME IN COLS. 23-66 000A 39800018 MVC 70(14,R10),69(R10) PUT BLANKS IN COLS. 67-80 40000018 MVI 75(R10),ALCX INDICATE CONTINUATION 19018 40050019 LA R10,56(R10) STEP TOWARD END OF DSNAME 19018 40100019 BAL R9,STEP PUT COMMA AFTER DSNAME 19018 40150019 X R4,LRDDEC80 SET JCL BUFFER INDEX TO 80 OR 0 40200018 STC R4,LRDCDIND(R3) TO INDICATE 1 OR 2 CARDS IN BUFFER 40400018 * (80 MEANS 1 CARD, 0 MEANS 2 CARDS) 40600018 BAL R10,LRDWRASG WRITE BUFFER AND ASSIGN NEXT TTR 40800018 LA R9,LRDSCDHF(R3) GET ADDRESS OF BUFFER FOR JFCB 41000018 LH R10,LCBBLKSZ GET BLKSIZE FROM LCB 000C 41200018 LTR R10,R10 SEE IF IT IS ZERO 000C 41400018 BC 7,ALCMVBLK IF SO, 000C 41600018 MVC LCBBLKSZ(2),JFCBLKSI GET THE BLKSIZE FROM THE JFCB 000C 41800018 ALCMVBLK MVC JFCBLKSI(2),LCBBLKSZ PUT CURRENT BLKSIZE IN JFCB 000C 42000018 LH R10,LCBPARM3+2 GET BLOCKSIZE FROM DCB PARAMETER000C 42200018 LTR R10,R10 SEE IF BLKSIZE WAS SPECIFIED 000C 42400018 BZ LRDNODCB IF NOT, GET BLKSIZE FROM PROC 000C 42600018 STH R10,JFCBLKSI OVERRIDE BLKSIZE IN PROC 000C 42800018 B LRDTOBIG 000C 43000018 LRDNODCB LH R10,JFCBLKSI GET BLKSIZE FROM PROC 000C 43200018 LTR R10,R10 TEST BLOCK SIZE FOR ZERO 43400018 BZ LRDBLK0 BRANCH IF ZERO BLOCK SIZE 43600018 LRDTOBIG CH R10,LRD400 TEST FOR BLOCK SIZE OVER 400 43800018 BH LRDBLKHI BRANCH IF BLOCK SIZE MORE THAN 400 44000018 LRDOPSYS OPEN ((8),(OUTPUT)),TYPE=J OPEN DCB FOR SYSIN DATA 44200018 SR R15,R15 SET NORMAL RETURN CODE 44400018 LRDRETRN LM R12,R14,LRDSAVE(R3) RESTORE REGISTERS 12,13,14 000A 44600018 LA R1,LRDEXLST GET ADDRESS OF EXLST FOR OUT OF 000A 44800018 ST R1,DCBEXLST SPACE HANDLER 000A 45000018 MVI DCBEXLST,LRDFB RESET RECFM TO FB 000A 45200018 BR R14 RETURN TO IHKABLRD 45400018 SPACE 2 45600018 LRDBLK0 LA R10,80 GET BLOCK SIZE OF 80 45800018 STH R10,JFCBLKSI STORE IN JFCB 46000018 B LRDOPSYS 46200018 SPACE 2 46400018 LRDBLKHI LA R10,400 GET BLOCK SIZE OF 400 46600018 STH R10,JFCBLKSI STORE IN JFCB 46800018 B LRDOPSYS 47000018 SPACE 2 47200018 SPACE 2 47800018 LRDWRASG L R9,LCBTDIR GET ADDR OF TERMINAL DIRECTORY ENTRY 48000018 S R9,LRDCDTDR SUBTRACT START OF TERM DIREC ENTRIES 48200018 ST R9,LRDRELTD(R3) STORE RELATIVE DISPLACEMENT WITHIN 48400018 * TERMINAL DIRECTORY 48600018 L R1,LCBBUFER GET QUEUE MANAGER PARAM. AREA ADDR. 48800018 MVI QMPOP,QMWRTA STORE WRITE AND ASSIGN CODE 49000018 MVI QMPCM,LRDWR1AS WRITE ONE RECORD AND ASSIGN ONE TTR 49200018 ST R3,QMPCA STORE ADDR OF BUFFER TO BE WRITTEN 49400018 ST R1,LCBPARM1 STORE QMPA ADDRESS FOR IHKQMNGR 000A 49600018 XC DECSDECB(4),DECSDECB CLEAR ECB 000A 49800018 ST R7,LCBPARM2 STORE ECB ADDRESS FOR IHKQMNGR 000A 50000018 LA R0,LCBPARM1 GET ADDRESS OF PARAMETER LIST 000A 50200018 LA R1,LCBQMECB GET ADDRESS OF ECB FOR IHKQMNGR 000A 50400018 POST (1),(0) POST THE ECB FOR IHKQMNGR 000A 50600018 LR R1,R7 GET ADDRESS OF DISK ECB 000A 50800018 L R15,LRDAADSP GET ADDRESS OF DISPATCHER 000A 51000018 BALR R14,R15 HAS MULTIPLE WAIT 000A 51200018 CLI DECSDECB+3,LRDZERO CHECK RETURN CODE 000A 51400018 BC 7,LRDQMIOE BRANCH IF I/O ERROR 51600018 L R1,LCBBUFER GET QUEUE MANAGER PARAM. AREA ADDR. 51800018 L R9,QMCHN GET TTR FOR NEXT WRITE 52000018 ST R9,QMPEX PUT TTR IN PROPER PARAMETER WORD 52200018 L R9,QMPCA GET TTR JUST ASSIGNED 52400018 ST R9,QMCHN SAVE IN CHAINING WORD OF BUFFER 52600018 MVI LRDCDIND(R3),LRDNOCRD INDICATE NO CARDS IN BUFFER 52800018 BR R10 53000018 SPACE 2 53200018 LRDQMIOE LA R15,4 SET RETURN CODE FOR QMPA I/O ERROR 53400018 B LRDRETRN 53600018 SPACE 2 53800018 LRDSYSSP LA R15,8 SET RETURN CODE FOR NO SPACE - ALLOC 54000018 B LRDRETRN 54200018 SPACE 2 54400018 ALCCOMMA EQU C',' COMMA 19018 54450019 ALCBLANK EQU C' ' BLANK 19018 54500019 ALCX EQU C'X' TO INDICATE CONTINUATION 19018 54550019 LRDSYSIN EQU 39 READER READY QUEUE NUMBER 54600018 LRDZERO EQU 0 000A 54800018 LRDJFCB7 EQU 7 TO INDICATE EXLST ENTRY FOR JFCB 55000018 LRDNWDS EQU X'C0' TO INDICATE NEW DATA SET IN JFCB 55200018 LRDZONE EQU X'F0' TO CHANGE SIGN BITS TO ZONE BITS 55400018 LRDWR1AS EQU X'11' WRITE ONE RECORD AND ASSIGN ONE TTR 55600018 LRDNOCRD EQU X'10' TO INDICATE NO CARDS IN BUFFER 55800018 LRDPOST EQU X'40' TO POST ECB FOR IHKQMNGR 000A 56000018 LRDFB EQU X'90' TO RESET RECFM TO FB 000A 56200018 LRDRELTD EQU 164 DISPLACEMENT FOR RELATIVE TDIR PTR 56400018 LRDCDIND EQU 168 DISPLACEMENT FOR CARD INDICATOR 56600018 LRDSAVE EQU 180 DISPLACEMENT FOR SAVE AREA 000A 56800018 LRDXLST EQU 192 DISPLACEMENT FOR EXLST 000A 57000018 LRDSCDHF EQU 200 DISPLACEMENT FOR SECOND HALF OF BUF 57200018 LRDJOBCH EQU 448 DISPLACEMENT FOR NUMBER OF 000A 57400018 * CHARACTERS IN JOBNAME 000A 57600018 LRDDSNAM DC C'DSNAME=' THESE FIVE CONSTANTS ARE USED 000A 57800018 LRDSYS DC C'SYS' TO BUILD A DSNAME OF THE FORM 000A 58000018 LRDPERT DC C'.T123456' DSNAME=SYSXXXXX.T123456.I0007. 1655 58200018 LRDRDRNO DC C'.IV007. ' JOBNAME.SXXXXXXX 35909 58400020 LRDPERS DC C'.S' FOR SYSIN DATA SETS 000A 58600018 LRDDDCD1 DC C'DD UNIT=XXXX,DISP=(OLD,DELETE),VOLUME=SER=XXXXXX X' 58800021 UNITNO EQU LRDDDCD1+8 UNIT FIELD IN SYSIN DD A44704 59000021 VOLUME EQU LRDDDCD1+42 0576 59200018 LRDUNITS DC C'0000231123012303230223142314231423143330' UNITS A44704 59400021 LRDALRET DC H'12' TO TEST RET CODE FROM ALLOCATE 000A 59600018 LRD400 DC H'400' TO CHECK SYSIN BLOCKSIZE 000A 59800018 LRDCNTR DC F'0' DSNAME COUNTER 60000018 LRDABCON DC A(IHKABCON) TO SET BASE FOR CONSTANT DSECT 60200018 SPACE 60400018 EJECT 61600018 IEFQMNGR QUEUE MANAGER PARAMETER AREA 61800018 QMPCA DS CL4 BUFFER ADDRESS OR TTR FROM ASSIGN 62000018 QMPEX DS CL4 TTR FOR WRITE 62200018 QMCHN DS CL4 TTR FOR NEXT WRITE 62400018 EJECT 62600018 IECTDECB 62800018 EJECT 63000018 DCBD DSORG=(BS,BX),DEVD=DA 63200018 EJECT 63400018 LRDJFCBN DSECT 63600018 IEFJFCBN 63800018 EJECT 64000018 LRDUCBOB DSECT 64200018 IEFUCBOB 64400018 EJECT 64600018 LRDCVT DSECT 64800018 CVT 65000018 EJECT 65200018 LRDCONST DSECT DSECT OF CONSTANTS IN IHKABLRD 65400018 CNOP 4,8 19018 65500019 LRDSPENT DS F HAS F'0' 000A 65600018 LRDSLASH DS CL3 HAS '// ' 65800018 LRDTASK DS CL8 66000018 LRDHEADR DS CL9 66200018 LRDDLSTX DS CL2 66400018 LRDSOHD DS CL2 000A 66600018 LRDSOHR DS CL2 000A 66800018 LRDCDJAM DS CL2 000A 67000018 LRDCHARS DS H 000A 67200018 LRD3 DS H 000A 67400018 LRD4 DS H TO CHECK UNIT TYPE IN UCB 000A 67600018 LRD8 DS H 000A 67800018 LRD18 DS H 000A 68000018 LRD84 DS H 000A 68200018 LRD200 DS H 000A 68400018 LRDUCBAD DS F ADDRESS OF UCB ADDRESS 68600018 LRDDEC80 DS F TO INDEX JECL-JCL BUFFER 68800018 LRDSVBLK DS F 000A 69000018 LRDCCSCN DS F 69200018 LRDAADSP DS F 69400018 LRDCAINT DS F 69600018 LRDCBLDM DS F 69800018 LRDCDFMR DS F 70000018 LRDCDSCH DS F 70200018 LRDABALC DS F 70400018 LRDABLST DS F 70600018 LRDABXMT DS F 000A 70800018 LRDABLRD DS F 71000018 LRDCDFLN DS F 71200018 LRDCDSOC DS F 71400018 LRDCDTDR DS F START OF TERMINAL DIRECTORY ENTRIES 71600018 LRDZZAVT DS F 000A 71800018 LRDEXLST DS F HAS X'88', AL3(LRDOUTSP) 000A 72000018 CNOP 0,8 19018 72050019 LRDUPDEC DS 2F UNPACKED DECIMAL 19018 72100019 LRDDECNO DS F PACKED DECIMAL 19018 72150019 EJECT 000A 72200018 IHKDSECT ,,,,LCB 000A 72400018 IHKDSECT ,,,,,AVT 000B 72600018 END 72800018 ./ ADD SSI=21450162,NAME=IHKABLRD,SOURCE=0 LRDE TITLE 'IHKABLRD - LINE ANALYSIS READ' 00050020 IHKABLRD CSECT 00100020 * 001800-014400,019200-019800,033600-040800,120000,236010-236080 19018 00650020 * 478800,604200,654600,666000-666600,749400-770400 19018 00700020 * 778800-779400,781200,787200-823800,872400 19018 00750020 * 747600-748800 A24717 00800020 * 643800-644400 A27468 00850020 * 157200,515400,636000,862800-863400 000D 00900020 * 445800-446400,970800 000D 00950020 * 473400-542400,862200-866400,933000-934200 A26537 01000020 * A32862 01050020 * A32875 01100020 *A596100-596400,747200 A35897 01110020 *D474500 A40161 01120020 *A474100-474700,480500,730600-730800 A40161 01130020 *C302500,653000 A40166 01135020 *A678000 M6294 01140020 *D747200 M6294 01145020 *A114100-114300 A37771 01147021 *A620900-622100 A47439 01157021 *D621000-622000 A47439 01167021 *C593500,611000 A47967 01177021 *A198100-198200,324800-325100,559600-559900,681100-681200 A48402 01187021 *D325000 A48402 01197021 *A235700 A51866 01207021 * * 01217021 * STATUS - CHANGE LEVEL 1, RELEASE 21.6 * 01227021 * * 01237021 *FUNCTION/OPERATION - THE BASIC FUNCTIONS OF THIS ROUTINE ARE * 01250020 * 1. READ THE INPUT DATA USING BTAM * 01300020 * 2. RECOGNIZE THE DATA LINK CONTROL CHARACTERS ON THE INPUT RECORD * 01350020 * 3. SEQUENCE CHECK THE JECL COMMANDS - RJSTART, CONTINUE, LOGON, * 01400020 * LOGOFF AND RJEND * 01450020 * 4. CHECK FOR THE INVALID JECL COMMANDS - RJENDF AND RJENDC * 01500020 * 5. WRITE THE JECL AND JCL RECORDS ON SYS1.SYSJOBQE USING THE OS * 01550020 * QUEUE MANAGER * 01600020 * 6. START A NEW QUEUE ENTRY FOR JECL AND JCL WHEN A JED CARD OR A * 01650020 * JOB CARD NOT PRECEDED BY A JED IS FOUND * 01700020 * 7. WRITE SYSIN DATA ON A SEQUENTIAL DISK DATA SET WHICH WAS JUST * 01750020 * ALLOCATED * 01800020 * 8. SUPPORT SYSTEM MANAGEMENT FACILITIES (SMF) BY COUNTING 19018 01850020 * RECORDS SPOOLED TO SYSIN DATA SETS. THE COUNT IS PLACED 19018 01900020 * IN A SPACE PARAMETER ON THE THIRD GENERATED SYSIN CARD. 19018 01950020 * * 02000020 *ENTRY POINTS - * 02050020 * IHKABLRD - TO PROCESS THE BTAM INPUT. * 02100020 * CALLING SEQUENCE - LA 1,PARAM * 02150020 * LA 13,SAVE AREA FOR THIS LINE * 02200020 * L 15,=V(IHKABLRD) * 02250020 * BR 15 * 02300020 * WHERE PARAM IS A WORD CONTAINING THE LCB ADDRESS * 02350020 * * 02400020 * IHKABCON - TO ENABLE IHKABALC TO GET THE BASE FOR A DSECT OF * 02450020 * THIS CONSTANT AREA. * 02500020 * * 02550020 * IHKABXCN - TO ENABLE IHKABXMT TO GET THE BASE FOR A DSECT 000A 02600020 * OF THE CONSTANT AREA. 000A 02650020 * 000A 02700020 * IHKABRET - TO WRITE A RECORD (JCL) AND RETURN TO LST 19018 02750020 * 19018 02800020 *INPUT - BTAM PUTS 80-CHARACTER CARD IMAGES AND THE DATA LINK CONTROL * 02850020 * CHARACTERS IN THE INPUT BUFFER ON EACH READ. THE READ INITIAL IS * 02900020 * DONE BY THE LINE SCHEDULER PRIOR TO CALLING THIS ROUTINE WHICH * 02950020 * ISSUES THE READ CONTINUE'S. * 03000020 * * 03050020 *OUTPUT - THE JECL AND JCL IS ON SYS1.SYSJOBQE, TWO 80-CHARACTER CARD * 03100020 * IMAGES PER EACH 176-BYTE RECORD. THE SYSIN DATA SET(S) ARE ON * 03150020 * DISK, BLOCKED ACCORDING TO THE BLOCK SIZE SPECIFIED ON THE DD CARD* 03200020 * IN THE RJE PROCEDURE. THE MAXIMUM BLOCK SIZE IS 400 BYTES. IF NO* 03250020 * BLOCK SIZE WAS SPECIFIED, UNBLOCKED (80-BYTE) RECORDS ARE WRITTEN * 03300020 * * 03350020 *EXTERNAL ROUTINES - * 03400020 * IHKAADSP - DISPATCHER TO ALLOW PROCESSING OF OTHER * 03450020 * LINES WHILE WAITING FOR I/O TO* 03500020 * COMPLETE. * 03550020 * IHKABALC - SYSIN ALLOCATION TO ALLOCATE A SYSIN DATA SET. * 03600020 * IHKABXMT - ERR MSG TRANSMITTER TO TRANSMIT AN ERROR 000A 03650020 * MESSAGE TO THE LINE 000A 03700020 * IHKCAVER - COMMAND INTERPRETER TO CHECK THE SYNTAX OF AN * 03750020 * RJSTART OR LOGON CARD. * 03800020 * IHKCBLDM - BUILD MESSAGE TO GET A POINTER TO AN ERROR * 03850020 * MESSAGE. * 03900020 * IHKCCSCN - SCAN TO FIND THE START OF FIELDS ON* 03950020 * JECL AND JCL CARDS. * 04000020 * IHKCDFMR - FAST TABLE MANAGER TO WRITE UPDATED FAST TABLE * 04050020 * ENTRY ON DISK. * 04100020 * IHKCDSCH - FAST TABLE SEARCH TO SEARCH FAST TABLE FOR * 04150020 * AVAILABLE ENTRY OR DUPLICATE * 04200020 * JOB NAME * 04250020 * IHKCHUPK - UNPACK ROUTINE TO EXPAND RECORDS FROM 000D 04300020 * A COMPRESSING TERMINAL 000D 04350020 * IHKQMNGR - TO INTERFACE WITH IEFQMSSS 000A 04400020 * AND IEFQDELE 000A 04450020 * BSAM TO WRITE THE SYSIN DATA SETS * 04500020 * ON DISK. * 04550020 * BTAM TO READ INPUT FROM THE LINE * 04600020 * * 04650020 *EXITS - NORMAL - RETURN IS MADE TO THE LINE SCHEDULER WITH A 000A 04700020 * RETURN CODE IN REGISTER 15 AS FOLLOWS 000A 04750020 * 0 - RETURN FOR NON-SWITCHED LINE OR AFTER RJENDC OR RJENDF 000A 04800020 * 8 - ERROR MESSAGE WAS SENT ON SWITCHED LINE SO LINE SCHEDULER 000A 04850020 * MUST SEND EOT 000A 04900020 * 12 - LINE SCHEDULER SHOULD CALL IHKABLWR BECAUSE AN OUT-OF- 000A 04950020 * SPACE CONDITION OCCURRED 000A 05000020 * 20 - RJENDC OR RJENDF NOT QUEUED BECAUSE SYS1.SYSJOBQE IS 000A 05050020 * TEMPORARILY OUT OF SPACE 000A 05100020 * 24 - NORMAL RETURN FOR SWITCHED LINE 000A 05150020 * 28 - RETURN TO SEND EOT TO 2780 ON SWITCHED LINE BECAUSE 000A 05200020 * RJSTART OR LOGON IS REQUIRED. 000A 05250020 * * 05300020 *EXITS - ERROR - THE LINE ERROR RECOVERY PROCEDURES ARE THOSE SUPPLIED* 05350020 * BY OS/BTAM/BSCS. IF AN ERROR OCCURS ON THE LINE, IT IS RETRIED BY* 05400020 * BTAM SIX TIMES. IF THE ERROR IS NOT RECOVERABLE, BTAM POSTS A BAD* 05450020 * RETURN CODE (41). IF LINE ANALYSIS READ FINDS A BAD RETURN CODE, * 05500020 * IT EXECUTES THE FOLLOWING PROCEDURE. THE USER EXIT ROUTINE (OR A * 05550020 * DUMMY ROUTINE) IS CALLED WITH A POINTER TO THE LINE DECB IN * 05600020 * REGISTER 1. THEN IN THE TERMINAL DIRECTORY ENTRY, THE ENQUEUE * 05650020 * JOBS AND ENQUEUE MESSAGES BITS ARE TURNED OFF, THE DEQUEUE 000A 05700020 * NOTHING BIT IS TURNED ON, THE RJSTART AND LOGON SWITCHES ARE 000A 05750020 * TURNED OFF. AN RJENDF CARD WITH THE LINE ERROR MESSAGE ON IT 000A 05800020 * IS GENERATED AND PUT ON THE JECL AND JCL QUEUE ENTRY. THE 000A 05850020 * QUEUE ENTRY IS ENQUEUED FOR THE READER, AND RETURN IS MADE TO 000A 05900020 * THE LINE SCHEDULER. 000A 05950020 * * 06000020 * IHKABXMT IS CALLED IF ANY OF THE FOLLOWING ERRORS OCCURS 000A 06050020 * 1. RJSTART OR LOGON IS MISSING OR INVALID, * 06100020 * 2. RJENDF OR RJENDC IS SUBMITTED FROM THE TERMINAL, * 06150020 * 3. A JOB CARD IS MISSING OR THE JOB NAME IS MISSING, TOO LONG, OR * 06200020 * DUPLICATE, * 06250020 * 4. THE FAST TABLE IS FULL, * 06300020 * 5. THE CENTRAL IS OUT OF SPACE FOR SYSIN OR ON SYS1.SYSJOBQE, 000A 06350020 * 6. THE SYSIN DATA SET IS TOO LONG, OR 000A 06400020 * 7. A DISK I/O ERROR OCCURS. 000A 06450020 * * 06500020 * AN ERROR MESSAGE IS SENT TO THE TERMINAL, AND FOR CASES 4, 5 000A 06550020 * AND 7 A MESSAGE IS ALSO SENT TO THE CENTRAL OPERATOR. IF THE 000A 06600020 * WRITE TO THE TERMINAL IS UNSUCCESSFUL, AN RJENDF CARD WITH THE 000A 06650020 * ERROR MESSAGE IS GENERATED, IF POSSIBLE, AND PUT ON THE JECL 000A 06700020 * AND JCL QUEUE ENTRY. THE QUEUE ENTRY IS ENQUEUED FOR THE 000A 06750020 * READER, AND RETURN IS MADE TO THE LINE SCHEDULER. 000A 06800020 * * 06850020 * ABNORMAL CENTRAL CLOSEDOWN IS INITIATED WHEN AN UNRECOVERABLE 000B 06900020 * ERROR IS ENCOUNTERED. 000B 06950020 * 000B 07000020 *TABLES/WORK AREAS - EACH LINE HAS A LINE CONTROL BLOCK (LCB), * 07050020 * SUB-TASK CONTROL BLOCK (STCB), 452-BYTE DISK BUFFER, 18-WORD * 07100020 * REGISTER SAVE AREA, A DECB AND DCB FOR LINE I/O, AND A DECB AND * 07150020 * DCB FOR DISK I/O ASSOCIATED WITH IT. WHILE THE LINE IS SENDING * 07200020 * INPUT, A BTAM BUFFER IS ALSO USED. THE FAST TABLE, THE TERMINAL * 07250020 * DIRECTORY AND THE AVT TABLE OF ADDRESSES ARE REFERENCED. * 07300020 * * 07350020 *ATTRIBUTES - IT IS REENTRANT. * 07400020 * * 07450020 *NOTES - THE OPERATION OF THIS SUBROUTINE DEPENDS UPON AN INTERNAL * 07500020 * REPRESENTATION OF THE EXTERNAL CHARACTER SET WHICH IS EQUIVALENT * 07550020 * TO THE ONE USED AT ASSEMBLY TIME. THE CODING HAS BEEN ARRANGED SO* 07600020 * THAT REDEFINITION OF CHARACTER-TYPE CONSTANTS, BY REASSEMBLY, WILL* 07650020 * RESULT IN A CORRECT MODULE FOR THE NEW DEFINITION EXCEPT FOR THE * 07700020 * CODE WHICH VERIFIES THAT THE JOB NAME STARTS WITH AN ALPHABETIC * 07750020 * CHARACTER. THE CODE ASSUMES THAT ALL SPECIAL CHARACTERS HAVE A * 07800020 * LOWER HEX CODE THAN THE LETTERS, THAT THE NUMBERS HAVE A HIGHER * 07850020 * HEX CODE, THAT THE HEX CODE FOR A IS THE LOWEST ALPHABETIC, THAT * 07900020 * THE HEX CODE FOR Z IS THE HIGHEST ALPHABETIC, AND THAT THE NUMERIC* 07950020 * FIELDS OF THE LETTERS RUN FROM 1 THROUGH 9 EXCEPT FOR E1. THE * 08000020 * LAST 5 EQUATES ARE USED FOR THIS CODE. * 08050020 * THE CODE WHICH INSERTS THE SYSIN COUNT INTO THE SPACE PARA- 19018 08100020 * METER OF THE THIRD GENERATED SYSIN CARD ASSUMES THAT THE 19018 08150020 * HEXADECIMAL REPRESENTATION OF THE NUMBERS IS 'F0' THROUGH 19018 08200020 * 'F9'. THE EQUATE FOR THE ZONE IS LABELLED 'LRDZONE'. 19018 08250020 * NOTE A26537 08300020 * THE SUB ROUTINE STARTING STARTING FROM SEQUENCE NUMBER A26537 08350020 * 473290-542400 HAS BEEN REARRANGED SUCH THAT IT IS A SUB- A26537 08400020 * ROUTINE WITH ITS OWN BASE REG . THIS WAS DONE TO MAKE ROOM A26537 08450020 * IN THIS MODULE FOR FUTURE FIXES AND MODIFICATIONS . A26537 08500020 * ALSO CHARACTER CONSTANTS AND OTHER DEPENDENT CODE WAS EITHER A26537 08550020 * DELETED FROM THE MAIN ROUTINE AND MOVED OR DUPLICATED A26537 08600020 * IN THE SUB ROUTINE A26537 08650020 SPACE 2 08700020 R0 EQU 0 08750020 R1 EQU 1 QUEUE MANAGER PARAM. AREA POINTER 08800020 R2 EQU 2 LCB POINTER 08850020 R3 EQU 3 BUFFER POINTER 08900020 R4 EQU 4 0 OR 80 FOR JECL-JCL BUFFER POINTER 08950020 * END OF BUFFER FOR DISK BUFFER PTR 09000020 R5 EQU 5 BTAM BUFFER POINTER 09050020 R6 EQU 6 END OF BTAM BUFFER POINTER 09100020 R7 EQU 7 DECB POINTER (LINE OR DISK) 09150020 R8 EQU 8 DCB POINTER FOR DISK 09200020 R9 EQU 9 VARIABLE 09250020 R10 EQU 10 VARIABLE 09300020 R11 EQU 11 TERMINAL DIRECTORY POINTER 09350020 R12 EQU 12 BASE REGISTER 09400020 R13 EQU 13 SAVE AREA POINTER 09450020 R14 EQU 14 RETURN REGISTER 09500020 R15 EQU 15 ENTRY POINT REGISTER 09550020 SPACE 09600020 EXTRN IHKCDFLN,IHKCDSOC,IHKCDTDR,IHKCACOM 09650020 ENTRY IHKABCON FOR DSECT IN IHKABALC 09700020 ENTRY IHKABRET 19018 09750020 ENTRY IHKABXCN FOR DSECT IN IHKABXMT 000A 09800020 SPACE 09850020 BALR R12,0 INITIALIZE BASE REGISTER 09900020 USING *,R12 09950020 USING IOPARAMS,R1 10000020 USING LCBDSECT,R2 10050020 USING IECTDECB,R7 10100020 USING IHADCB,R8 10150020 USING TDIREC,R11 10200020 USING LRDCVT,R14 10250020 USING LRDQMRES,R15 10300020 B LRDSKIP 10350020 DC C'IHKABLRD' 10400020 LRDSKIP DS 0H 10450020 * 10500020 *********************************************************************** 10550020 * 10600020 * INITIALIZE REGISTERS AND ASSIGN QUEUE ENTRY 10650020 * 10700020 *********************************************************************** 10750020 * 10800020 L R2,0(R1) GET LCB ADDRESS 10850020 NI LCBNSWFL,LCBSWOFF TURN OFF LCB SWITCHES 10900020 L R7,LCBDDECB GET DISK DECB POINTER FROM LCB 10950020 L R8,DECDCBAD GET ADDRESS FOR DCB 11000020 MVC 0(88,R8),LRDSYSDD MOVE MODEL DCB FOR SYSIN DATA SETS 11050020 L R7,LCBLDECB GET LINE DECB POINTER FROM LCB 11100020 BAL R10,LRDBUFPT GET POINTERS TO START AND END 000A 11150020 * OF BTAM BUFFER 000A 11200020 ST R5,LCBWORKA SAVE ADDRESS OF BTAM INPUT BUFFER 11250020 L R11,LCBTDIR GET TERMINAL DIRECTORY PTR 11300020 LA R10,LRDCHECK SET RETURN ADDRESS 11350020 SR R4,R4 SET BUFFER INDEX TO 0 A27468 11400020 L R4,LCBBUFER CLEAR THE QMPCL SO THAT IF THE JOB A37771 11410021 XC LRDXMT32(LRDXMT4,R4),LRDXMT32(R4) Q IS FULL AND A37771 11420021 * THE MSG CAN'T BE SENT - NO ABEND A37771 11430021 SPACE 1 11450020 CLI LCBTYPLN,LCBMULPT CHECK FOR MULTI-POINT LINE 000A 11500020 BNE LRDASGST BRANCH IF NOT MULTI-POINT LINE 000A 11550020 LA R5,1(R5) STEP PAST POLLING CHARACTER 000A 11600020 LRDASGST L R14,CVTPTR GET ADDRESS OF CVT 11650020 L R15,CVTJOB GET ADDRESS OF Q MGR RESIDENT AREA 11700020 LH R9,QMNOTM GET NUMBER OF AVAIL. LOGICAL TRACKS 11750020 SH R9,QMTBT SUBTRACT NUMBER OF LOGICAL TRACKS 11800020 * RESERVED FOR INITIATORS 11850020 MH R9,QMLPT MULTIPLY BY NUMBER OF RECORDS/TRACK 11900020 * R9 NOW HAS NUMBER OF AVAIL. RECORDS 11950020 CH R9,LRD200 CHECK THRESHOLD OF 200 RECORDS 000A 12000020 BNH LRDQMSPA BRANCH IF NOT MORE THAN 200 RECORDS 12050020 LRDASGS2 L R1,LCBBUFER GET QUEUE MANAGER PARAM. AREA ADDR. 12100020 MVC QMNAM(8),LRDTASK PUT RJETASK AS JOBNAME 12150020 XC QMFLT(23),QMFLT CLEAR NEXT SIX WORDS OF QMPA 12200020 LA R9,QMPCA GET ADDRESS OF EXTERNAL AREA 12250020 ST R9,QMPCL STORE IN LAST WORD OF QMPA 12300020 MVI QMPOP,QMASGS STORE ASSIGN/START CODE 12350020 MVI QMTPY,LRDSYSIN SET FOR SYSIN QUEUE 12400020 MVI QMPCM,LRD2TTRS TO ASSIGN TWO TTR'S 12450020 BAL R9,LRDQMNGR ASSIGN/START 000A 12500020 BC 7,LRDQMIOA BRANCH IF I/O ERROR 12550020 L R1,LCBBUFER GET QUEUE MANAGER PARAM. AREA ADDR. 12600020 L R9,QMPEX GET TTR FOR SECOND WRITE 12650020 ST R9,QMCHN STORE AS CHAINING FROM FIRST RECORD 12700020 L R9,QMPCA GET TTR FOR FIRST WRITE 12750020 ST R9,QMPEX STORE AS TTR FOR FIRST WRITE 12800020 LA R3,QMCHN GET JECL AND JCL BUFFER ADDRESS 12850020 SR R4,R4 SET BUFFER INDEX TO 0 000D 12900020 MVI LRDCDIND(R3),LRDNOCRD INDICATE NO CARDS IN BUFFER 12950020 NI LCBNSWFL,LCBNQOFF INDICATE NO CARDS TO ENQUEUE 000A 13000020 BR 10 13050020 SPACE 1 13100020 LRDCHECK BAL R9,LRDCKEOT CHECK DATA LINK CONTROL CHARACTERS 13150020 LTR R11,R11 TEST FOR TERMINAL DIRECTORY POINTER 13200020 BZ LRDRJNEC BRANCH IF RJSTART REQUIRED 13250020 TM TDIRSWCH,TDIRRJSN ALLOW FOR MULTIPOINT 000C 13300020 BZ LRDRJNEC IF NOT RJSTARTED, NEEDS TO BE 000C 13350020 LRDCKTYP DS 0H 000C 13400020 BAL R14,LRDUNPK UNPACK RECORD INTO OUTPUT BUFFER000C 13450020 CLC 0(3,R3),LRDDOTS CHECK FOR JECL 000C 13500020 BNE LRDJCLCK BRANCH IF NOT A JECL CARD 13550020 * 13600020 *********************************************************************** 13650020 * 13700020 * CHECK FOR CERTAIN JECL COMMANDS 13750020 * 13800020 *********************************************************************** 13850020 * 13900020 NI TDIRSWCH+2,TDIRJCLF TURN OFF JCL SWITCH 13950020 TM TDIRSWCH,TDIRDDAN TEST DD* SWITCH - SYSIN DATA 14000020 BC 14,LRDRJS BRANCH IF DD * SWITCH NOT ON 14050020 BAL R10,LRDSYEND BRANCH IF DD * SWITCH ON 14100020 B LRDCKTYP GO PROCESS RECORD 000C 14150020 LRDRJS LA R9,LRDCONTI SET RETURN ADDRESS 14200020 SPACE 1 14250020 LRDRJSTR LA R10,3(R3) GET STARTING ADDRESS FOR SCAN 000C 14300020 ST R10,LRDSADDR STORE IN PARAMETER LIST 14350020 LA R10,70(R3) GET STOPPING ADDRESS FOR SCAN 000C 14400020 ST R10,LRDSSTOP STORE IN PARAMETER LIST 14450020 XC LRDSCAN(4),LRDSCAN SET UP PARM FOR SCAN 000C 14500020 LA R1,LRDSCAN GET ADDRESS OF PARAMETER LIST 14550020 L R15,LRDCCSCN GET ADDRESS OF SCAN ROUTINE 14600020 BALR R14,R15 CALL SCAN TO FIND FIRST NON-BLANK 14650020 LTR R15,R15 TEST FOR NON-BLANK CHARACTER FOUND 14700020 BZ LRDNULL BRANCH IF NO OPERATION ON CARD 14750020 CLC 0(8,R1),LRDRJSTT CHECK FOR RJSTART CARD 000C 14800020 BE LRDRJSRT BRANCH IF FOUND 14850020 BR R9 BRANCH TO LRDCONTI OR LRDRJMIS 14900020 SPACE 1 14950020 LRDCONTI CLC 0(9,R1),LRDCONT CHECK FOR CONTINUE CARD 15000020 BE LRDCONTU BRANCH IF FOUND 15050020 CLC 0(6,R1),LRDLOGON CHECK FOR LOGON CARD 15100020 BE LRDLOGN BRANCH IF FOUND 15150020 CLC 0(4,R1),LRDJED CHECK FOR JED CARD 15200020 BE LRDJEDCD BRANCH IF FOUND 15250020 CLC 0(7,R1),LRDLOGOF CHECK FOR LOGOFF CARD 15300020 BE LRDLOGF BRANCH IF FOUND 15350020 CLC 0(6,R1),LRDRJEND CHECK FOR RJEND CARD 15400020 BE LRDRJND BRANCH IF FOUND 15450020 CLC 0(7,R1),LRDRJNDF CHECK FOR RJENDF CARD 15500020 BE LRDRJF BRANCH IF FOUND - ERROR 15550020 CLC 0(7,R1),LRDRJNDC CHECK FOR RJENDC 15600020 BE LRDRJF BRANCH IF FOUND - ERROR 15650020 LRDSEQCK TM TDIRSWCH,TDIRRJLG TEST FOR RJSTART AND LOGON FOUND 15700020 BO LRDJCLBF BRANCH IF BOTH FOUND ALREADY 15750020 SPACE 15800020 * 15850020 *********************************************************************** 15900020 * 15950020 * HANDLE ERRORS ON INPUT DATA 16000020 * 16050020 *********************************************************************** 16100020 * 16150020 * MISSING RJSTART OR LOGON 16200020 * 335400 A28204 16250020 LRDRJMIS LA R0,LRDXMT52 GET INPUT CODE FOR IHKABXMT 000A 16300020 B LRDCLXMT CALL IHKABXMT TO ABORT INPUT 000A 16350020 SPACE 2 000A 16400020 * INVALID RJSTART OR LOGON - SEND 000A 16450020 * COMMAND INTERPRETER'S MESSAGE 000A 16500020 LRDRJINV LA R0,LRDXMT44 GET INPUT CODE FOR IHKABXMT 000A 16550020 LRDRJLG STM R0,R1,LCBPARM1 STORE INPUT CODE AND 000A 16600020 * POINTER TO MESSAGE 000A 16650020 B LRDXMTCL CALL IHKABXMT TO SEND MESSAGE 000A 16700020 SPACE 2 16750020 * RJENDF OR RJENDC IS AN INAVLID 000A 16800020 * OPERATION 000A 16850020 LRDRJF TM TDIRSWCH+2,TDIRMCHN TEST FOR 2780 OR CPU 000A 16900020 BZ LRD2780 BRANCH IF 2780 TO GET NEXT CARD 000A 16950020 MVI LRDBOFS+1,LRDOFS20 PUT MESSAGE OFFSET AS PARAMETER 000A 17000020 LA R0,LRDXMT48 GET INPUT CODE FOR IHKABXMT 000A 17050020 B LRDCLXMT CALL IHKABXMT TO SEND MESSAGE 000A 17100020 SPACE 2 17150020 LRDNULL LTR R11,R11 IS THERE A TERMINAL DIRECTORY PTR 17200020 BZ LRDRJMIS BRANCH IF NO POINTER - ERROR 17250020 B LRDSEQCK 17300020 SPACE 2 17350020 LRDRJNEC DS 0H 000C 17400020 LA R3,4(R3) STEP PAST INFO 000C 17450020 MVC 0(80,R3),0(R5) MOVE CARD TO OUTPUT BUFFER 000C 17500020 CLC 0(3,R3),LRDDOTS CHECK FOR JECL 000C 17550020 BNE LRDRJMIS BRANCH IF NOT JECL - MISSING RJSTART 17600020 BAL R9,LRDRJSTR TO TEST FOR RJSTART CARD 17650020 B LRDRJMIS RJSTART MISSING - ERROR 17700020 SPACE 2 17750020 * 17800020 *********************************************************************** 17850020 * 17900020 * PROCESS JECL 17950020 * 18000020 *********************************************************************** 18050020 * 18100020 * RJSTART CARD 18150020 * 18200020 LRDRJSRT ST R1,LRDCDOPR STORE ADDRESS OF OPERATION AS PARAM 18250020 MVI LRDCDOPR,LRDRJSCD STORE RJSTART CODE AS PARAMETER 18300020 CLI LCBTYPLN,LCBPTPT CHECK FOR POINT-TO-POINT LINE 000A 18350020 BNE LRDRJSR BRANCH IF NOT POINT-TO-POINT 000A 18400020 SR R11,R11 CLEAR TDIR POINTER SO IHKCAVER 000A 18450020 * WILL SEARCH TDIR FOR TERMID 000A 18500020 LRDRJSR EQU * 000A 18550020 LA R10,LRDRJSTA 18600020 SPACE 1 18650020 LRDCALCI ST R3,LRDCDBEG STORE START OF CARD IMAGE 000C 18700020 L R9,LCBTDIR SAVE TDIR POINTER 000C 18750020 ST R11,LRDCTDIR STORE TERMINAL DIRECTORY POINTER 18800020 LA R1,LRDCDOPR GET ADDRESS OF PARAMETER LIST 18850020 O R1,LRDBLDM SET HIGH ORDER BIT TO INDICATE THAT 18900020 * THE CALL IS FROM COLLECTOR-EMITTER 18950020 L R15,LRDCAINT GET ADDRESS OF COMMAND INTERPRETER 19000020 BALR R14,R15 CHECK RJSTART SYNTAX AND TERMINAL ID 19050020 LTR R15,R15 TEST RETURN CODE 19100020 BR R10 19150020 SPACE 1 19200020 LRDRJSTA DS 0H 000C 19250020 L R11,LRDCTDIR GET TERMINAL DIRECTORY POINTER 19300020 BZ LRDRJSOK RJSTART IS VALID 000C 19350020 LTR R11,R9 RESTORE TDIR POINTER 000C 19400020 BZ LRDRJINV ERROR IF FIRST RJSTART BAD 000C 19450020 TM TDIRSWCH,TDIRRJSN SEE IF ALREADY RJSTARTED 000C 19500020 BZ LRDRJINV NO, SEND ERROR MESSAGE 000C 19550020 LRDRJSOK DS 0H 000C 19600020 CLC LCBTDIR+1(3),LRDCTDIR+1 SAME TERMID AS ALREADY ON? 1657 19650020 BE LRDRJSGD YES, LET HIM ON A21657 19700020 CLC LCBTDIR+1(3),LRDBLDM+1 TERMINAL ON LINE YET A21657 19750020 BNE LRDRJSBD NO, SEND ERROR MESSAGE 1657 19800020 LRDRJTST TM TDIRSWCH+1,TDIRDABN IS ANOTHR LINE RJENDFING A48402 19810021 BO LRDRJWT THIS TERMINAL - BRANCH IF SO A48402 19820021 L R9,LRDLCBAD GET FIRST LCB ADDR. A21657 19850020 LM R14,R15,LRDLINES GET LCB COUNT AND LENGTH ADDR A21657 19900020 LH R14,0(R14) GET LCB COUNT A21657 19950020 LA R2,0(R2) INSURE HIGH ORDER BYTE ZERO A21657 20000020 LRDLLOOP DS 0H A21657 20050020 CLC LRDCTDIR+1(3),13(R9) IS THIS TERMID ON LINE A21657 20100020 BE LRDRJSBD YES, CAN'T GET ON HERE A21657 20150020 AH R9,0(R15) STEP TO NEXT LCB A21657 20200020 BCT R14,LRDLLOOP TRY NEXT LCB A21657 20250020 LRDRJSGD DS 0H 1657 20300020 ST R11,LCBTDIR STORE IN LCB 20350020 OI TDIRSWCH+2,TDIRSWCN PRESET FOR SWITCHED 1657 20400020 CLI LCBTYPLN,LCBSWTCH CHECK FOR SWITCHED LINE 000A 20450020 BE LRDSETSW BRANCH IF SWITCHED LINE 000A 20500020 NI TDIRSWCH+2,TDIRSWCF SET FOR NON-SWITCHED LINE 000A 20550020 LRDSETSW DS 0H 1657 20600020 OI TDIRSWCH,TDIRRJSN TURN ON RJSTART SWITCH 20650020 ST R2,TDIRLCB STORE LCB ADDR IN TERMINAL DIRECTORY 20700020 B LRDJCLBF BRANCH TO MOVE CARD TO JECL BUFFER 20750020 SPACE 2 20800020 LRDRJST2 C R2,TDIRLCB COMPARE CURRENT LCB WITH LCB IN 20850020 * TERMINAL DIRECTORY ENTRY ALREADY 20900020 BE LRDRJSGD BRANCH IF THE SAME 1657 20950020 * TWO LINES ARE USING THE SAME TERMID 21000020 LRDRJSBD DS 0H 1657 21050020 LA R0,LRDXMT40 GET INPUT CODE FOR IHKABXMT 000A 21100020 B LRDCLXMT CALL IHKABXMT TO SEND MESSAGE 000A 21150020 SPACE 2 21200020 * 21250020 * CONTINUE CARD 21300020 * 21350020 LRDCONTU TM TDIRSWCH,TDIRRJSN TEST FOR RJSTART FOUND ALREADY 21400020 BO LRDJCLBF BRANCH IF FOUND 21450020 B LRDRJMIS BRANCH ON ERROR 21500020 SPACE 2 21550020 * 21600020 * LOGON CARD 21650020 * 21700020 LRDLOGN TM TDIRSWCH,TDIRRJSN TEST FOR RJSTART FOUND ALREADY 21750020 BZ LRDRJMIS BRANCH IF NO PRECEDING RJSTART-ERROR 21800020 ST R1,LRDCDOPR STORE ADDRESS OF OPERATION AS PARAM 21850020 MVI LRDCDOPR,LRDLGNCD STORE LOGON CODE AS PARAMETER 21900020 BAL R10,LRDCALCI 21950020 BC 7,LRDRJINV BRANCH IF ERROR RETURN CODE 000A 22000020 OI TDIRSWCH,TDIRLGNN SET LOGON SWITCH ON 22050020 B LRDJCLBF BRANCH TO MOVE CARD TO JECL BUFFER 22100020 SPACE 2 22150020 * 22200020 * JED CARD 22250020 * 22300020 LRDJEDCD TM TDIRSWCH,TDIRRJLG TEST FOR RJSTART AND LOGON FOUND 22350020 BC 14,LRDRJMIS BRANCH IF ONE OR BOTH MISSING 000A 22400020 OI TDIRSWCH+1,TDIRJEDN TURN ON JED SWITCH 22450020 TM LCBNSWFL,LCBNQBIT TEST FOR CARDS TO BE ENQUEUED 000A 22500020 BZ LRDJCLBF BR IF NO CARDS IN QUEUE ENTRY 000A 22550020 BAL R10,LRDWRJCL WRITE LAST RECORD AND ENQUEUE 22600020 BAL R10,LRDASGST ASSIGN/START NEW QUEUE ENTRY 22650020 B LRDJCLBF 22700020 SPACE 2 22750020 * 22800020 * LOGOFF CARD 22850020 * 22900020 LRDLOGF TM TDIRSWCH,TDIRRJLG TEST FOR RJSTART AND LOGON FOUND 22950020 BC 14,LRDRJMIS BRANCH IF ONE OR BOTH MISSING 000A 23000020 NI TDIRSWCH,TDIRLGNF TURN OFF LOGON SWITCH 23050020 B LRDJCLBF BRANCH TO MOVE CARD TO JECL BUFFER 23100020 SPACE 2 23150020 * 23200020 * RJEND CARD 23250020 * 23300020 LRDRJND TM TDIRSWCH,TDIRRJSN TEST FOR RJSTART FOUND ALREADY 23350020 BZ LRDRJMIS BRANCH IF NO PRECEDING RJSTART-ERROR 23400020 NI TDIRSWCH,TDIRRJLF TURN OFF RJSTART AND LOGON SWITCHES 23450020 NI TDIRSTAT,TDIRNQJF TURN OFF ENQUEUE JOBS BIT IN TDIR 23500020 OI TDIRSTAT,TDIRDQMN SET DEQUEUE MESSAGES ONLY BIT 23550020 MVC 3(6,R3),LRDRJEND PUT 'RJEND' IN COL. 4 A51866 23570021 B RJENDR GO DO SPECIAL RJEND PROCESS A26537 23600020 SPACE 1 23650020 * 23700020 *********************************************************************** 23750020 * 23800020 * PUT CARD IN JECL AND JCL BUFFER 23850020 * WRITE BUFFER IF FULL 23900020 * 23950020 *********************************************************************** 24000020 * 24050020 LRDJCLBF DS 0H 000C 24100020 L R1,LCBBUFER GET QMPA ADDRESS 000C 24150020 LA R3,QMCHN GET DISK BUFFER ADDRESS 000C 24200020 OI LCBNSWFL,LCBNQBIT INDICATE CARDS TO BE ENQUEUED 000A 24250020 X R4,LRDDEC80 SET JCL BUFFER INDEX TO 80 OR 0 24300020 STC R4,LRDCDIND(R3) TO INDICATE 1 OR 2 CARDS IN BUFFER 24350020 * (80 MEANS 1 CARD, 0 MEANS 2 CARDS) 24400020 BZ LRDFULL BUFFER FULL 000C 24450020 TM TDIRSWCH,TDIRRJSN RJEND RECEIVED? 000C 24500020 BO LRDNOTFL NO, CONTINUE SAME BUFFER 000C 24550020 X R4,LRDDEC80 INDICATE NEXT MOVE TO BEG. 000C 24600020 LRDFULL DS 0H 000C 24650020 LA R10,LRDNOTFL 24700020 SPACE 1 24750020 LRDWRASG LR R9,R11 GET ADDR OF TERMINAL DIRECTORY ENTRY 24800020 S R9,LRDCDTDR SUBTRACT START OF TERM DIREC ENTRIES 24850020 ST R9,LRDRELTD(R3) STORE RELATIVE DISPLACEMENT WITHIN 24900020 * TERMINAL DIRECTORY 24950020 L R1,LCBBUFER GET QUEUE MANAGER PARAM. AREA ADDR. 25000020 MVI QMPOP,QMWRTA STORE WRITE AND ASSIGN CODE 25050020 MVI QMPCM,LRDWR1AS WRITE ONE RECORD AND ASSIGN ONE TTR 25100020 ST R3,QMPCA STORE ADDR OF BUFFER TO BE WRITTEN 25150020 BAL R9,LRDQMNGR WRITE AND ASSIGN 000A 25200020 BC 7,LRDQMIOE BRANCH IF I/O ERROR 25250020 L R1,LCBBUFER GET QUEUE MANAGER PARAM. AREA ADDR. 25300020 L R9,QMCHN GET TTR FOR NEXT WRITE 25350020 ST R9,QMPEX PUT TTR IN PROPER PARAMETER WORD 25400020 L R9,QMPCA GET TTR JUST ASSIGNED 25450020 ST R9,QMCHN SAVE IN CHAINING WORD OF BUFFER 25500020 MVI LRDCDIND(R3),LRDNOCRD INDICATE NO CARDS IN BUFFER 25550020 BR R10 25600020 SPACE 2 000A 25650020 LRDQMNGR ST R1,LCBPARM1 STORE QMPA ADDRESS FOR IHKQMNGR 000A 25700020 L R7,LCBDDECB GET ADDRESS OF DISK DECB 000A 25750020 XC DECSDECB(4),DECSDECB CLEAR ECB 000A 25800020 ST R7,LCBPARM2 STORE ECB ADDRESS FOR IHKQMNGR 000A 25850020 LA R0,LCBPARM1 GET ADDRESS OF PARAMETER LIST 000A 25900020 LA R1,LCBQMECB GET ADDRESS OF ECB FOR IHKQMNGR 000A 25950020 POST (1),(0) POST THE ECB FOR IHKQMNGR 000A 26000020 LR R1,R7 GET ADDRESS OF DISK ECB 000A 26050020 L R15,LRDAADSP GET ADDRESS OF DISPATCHER 000A 26100020 BALR R14,R15 HAS MULTIPLE WAIT 000A 26150020 CLI DECSDECB+3,LRDZERO CHECK RETURN CODE 000A 26200020 BR R9 000A 26250020 SPACE 2 000A 26300020 LRDNTFUL LA R3,80(R3) STEP DISK BUFFER PTR TO NEXT CARD 26350020 * 26400020 *********************************************************************** 26450020 * 26500020 * TEST IF BTAM BUFFER EMPTY 26550020 * ISSUE READ CONTINUE IF EMPTY 26600020 * 26650020 *********************************************************************** 26700020 * 26750020 LRDNOTFL TM TDIRSWCH+2,TDIRMCHN TEST FOR CPU OR 2780 26800020 BZ LRD2780 BRANCH IF 2780 26850020 TM TDIRRB,TDIRPNRN DID WE UNPACK THIS RECORD? 000C 26900020 BNO LRDSTP80 NO, STEP BUFFER POINTER BY 80 000C 26950020 SR R15,R15 CLEAR REG. FOR IC 000C 27000020 IC R15,0(R5) GET LENGTH OF RECORD 000C 27050020 AR R5,R15 STEP TO NEXT RECORD 000C 27100020 B LRDBTAM CHECK FOR END OF BUFFER 000C 27150020 LRDSTP80 LA R5,80(R5) STEP BTAM BUFFER PTR TO NEXT CARD 27200020 LRDBTAM OI TDIRRB,TDIRUNPN RECORDS WILL BE UNPACKEDIF NEC. 000C 27250020 CR R5,R6 CHECK FOR END OF BTAM BUFFER 000C 27300020 BL LRDNXTCD BRANCH IF NOT END OF BUFFER 27350020 LRDREAD LA R9,LRDNXTCD SET RETURN ADDRESS 27400020 SPACE 1 27450020 L R7,LCBLDECB GET LINE DECB ADDRESS 000A 27500020 LRDRDTT L R5,DECAREA GET ADDRESS OF BTAM BUFFER 000A 27550020 SR R0,R0 CLEAR FIRST WORD OF BTAM BUFFER 000A 27600020 ST R0,0(0,R5) TO PERMIT CHECKING FOR CARD JAM 000A 27650020 READ (7),TT,MF=E READ FROM LINE 000A 27700020 BAL R10,LRDSIO CHECK FOR SUCCESSFUL READ 000A 27750020 BNE LRDBDRD BRANCH IF NOT SUCCESSFUL 27800020 LRDSRDTP BAL R10,LRDBUFPT GET POINTERS TO START AND END 000A 27850020 * OF BTAM BUFFER 000A 27900020 LRDCKEOT CLI 0(R5),LRDEOTCR CHECK FOR EOT 27950020 BE LRDEOT BRANCH IF FOUND 28000020 CLC 0(2,R5),LRDSOHD CHECK FOR SOH D 000A 28050020 BE LRDDISCN BRANCH IF DISCONTINUED INPUT 28100020 CLC 0(2,R5),LRDSOHR CHECK FOR SOH R 000A 28150020 BE LRDRESUM BRANCH IF RESUMING NORMAL INPUT 28200020 CLC 0(2,R5),LRDDLSTX CHECK FOR DLE STX 28250020 BNE LRDBDRD BRANCH IF NOT FOUND 28300020 LA R5,2(R5) STEP POINTER PAST DATA LINK CHARS. 28350020 BR R9 28400020 SPACE 1 28450020 LRDNXTCD DS 0H A28204 28500020 LTR R11,R11 TDIR POINTER? A28204 28550020 BZ LRDRJNEC NO, NEED RJSTART A28204 28600020 TM TDIRSWCH,TDIRDDDN TEST DD DATA SWITCH A28204 28650020 BZ LRDCKTYP BRANCH IF NOT PROCESSING DD DATA 28700020 BAL R14,LRDUNPK UNPACK RECORD INTO OUTPUT BUFFER000C 28750020 B LRDMVSYS BRANCH IF PROCESSING DD DATA SYSIN 28800020 SPACE 2 28850020 LRDBUFPT L R5,DECAREA GET ADDRESS OF BTAM BUFFER 000A 28900020 LH R6,DECLNGTH GET LENGTH OF BUFFER 000A 28950020 LH R0,DECCOUNT GET NUMBER OF UNFILLED BYTES 000A 29000020 SR R6,R0 GET NO. OF BYTES OF DATA IN BUF 000A 29050020 BZ LRDBDRD BRANCH TO RJENDF IF NO DATA 000A 29100020 AR R6,R5 SET REG 6 TO END OF BUFFER 000A 29150020 BCTR R6,0 SUBTRACT NO. DATA LINK CHARS. 000C 29200020 LR R15,R8 SAVE DISK DCB POINTER 000D 29250020 L R8,DECDCBAD GET LINE DCB POINTER 000D 29300020 TM DCBXMODE,ITBCHAR TEST IF ITB MODE SET 000D 29350020 BZ LRDITB NO DONT DECREMENT COUNT 000D 29400020 BCTR R6,R0 YES DECREMENT COUNT BY ONE 000D 29450020 LRDITB EQU * 000D 29500020 LR R8,R15 RESTORE DISK DCB POINTER 000D 29550020 BR R10 000A 29600020 SPACE 2 000A 29650020 * 29700020 *********************************************************************** 29750020 * 29800020 * EOT RECEIVED - CLEAN UP AND CALL LINE SCHEDULER 29850020 * 29900020 *********************************************************************** 29950020 * 30000020 LRDEOT LTR R11,R11 CHECK FOR TERMINAL DIRECTORY POINTER 30050020 BZ LRDDELET BRANCH IF NO POINTER 30100020 TM TDIRSWCH+1,TDIRDIPN TEST DISCONTINUED INPUT SWITCH 30150020 BO LRDDISCT BRANCH IF ON 30200020 LRD1130 TM TDIRSWCH,TDIRSYSN TEST DD DATA AND DD* SW A40166 30250020 BZ LRDWRTJC BRANCH IF BOTH SWITCHES OFF 30300020 BAL R10,LRDSYEND WRITE LAST SYSIN RECORD AND CLOSE 30350020 LRDWRTJC LA R10,LRDRELBF SET RETURN ADDRESS 30400020 SPACE 1 30450020 LRDWRJCL LR R9,R11 GET ADDR OF TERMINAL DIRECTORY ENTRY 30500020 S R9,LRDCDTDR SUBTRACT START OF TERM DIREC ENTRIES 30550020 LR R8,R3 SAVE ADDRESS OF CARD IMAGE 000C 30600020 L R1,LCBBUFER GET QUEUE MANAGER PARAM AREA ADD000C 30650020 LA R3,QMCHN GET ADDRESS OF OUTPUT BUFFER 000C 30700020 ST R9,LRDRELTD(R3) STORE RELATIVE DISPLACEMENT WITHIN 30750020 * TERMINAL DIRECTORY 30800020 MVI QMPOP,QMWREN STORE ENQUEUE CODE 30850020 MVI QMPNC,LRDWR1 TO WRITE ONE RECORD 30900020 TM LRDCDIND(R3),LRD1CRD TEST FOR NUMBER OF CARDS IN BUFFER 30950020 BC 9,LRD1CARD BRANCH IF ONE OR TWO CARDS IN BUFFER 31000020 MVI LRDCDIND(R3),LRDNOCRD INDICATE NO CARDS IN BUFFER 31050020 LRD1CARD SR R9,R9 31100020 ST R9,0(R3) SET CHAINING TTR TO ZERO 31150020 ST R3,QMPCA STORE ADDR OF BUFFER TO BE WRITTEN 31200020 BAL R9,LRDQMNGR WRITE AND ENQUEUE 000A 31250020 BC 7,LRDQMIOE BRANCH IF I/O ERROR 31300020 MVC 4(80,R3),0(R8) MOVE CARD TO BEGINNING OF BUFFER000C 31350020 L R8,DECDCBAD RESTORE DCB POINTER 000C 31400020 L R1,LCBBUFER GET ADDRESS OF JOB NAME 31450020 CLC QMNAM(8),LRDTASK CHECK FOR JOBNAME 31500020 BE LRDNOFST BRANCH IF ONLY JECL ON QUEUE ENTRY 31550020 L R15,LRDCDSCH GET ENTRY POINT OF FAST TABLE SEARCH 31600020 BALR R14,R15 FIND FAST TABLE ENTRY JUST ASSIGNED 31650020 * UPON RETURN REGISTER 1 CONTAINS THE 31700020 * ADDRESS OF FAST TABLE ENTRY 31750020 L R15,LRDCDFMR GET ENTRY POINT OF FAST TABLE MGR 31800020 BALR R14,R15 WRITE FAST TABLE ENTRY ON DISK 31850020 LRDNOFST BR R10 31900020 SPACE 1 31950020 LRDRELBF L R7,LCBLDECB GET ADDRESS OF LINE DECB 32000020 L R8,DECDCBAD GET ADDRESS OF LINE DCB 32050020 L R5,LCBWORKA GET ADDRESS OF BTAM BUFFER 32100020 SR R9,R9 STORE ZERO IN FIRST WORD OF BTAM 32150020 ST R9,0(R5) BUFFER TO INDICATE NO CHAINING 32200020 RELBUF (8),(5) RELEASE BTAM'S BUFFER 32250020 LTR R11,R11 CHECK FOR TERMINAL DIRECTORY POINTER 32300020 BZ LRDCKSWL BRANCH IF NONE 32350020 NI TDIRSWCH,TDIRDARF TURN OFF DD DATA, DD *, AND 32400020 * NO RJENDF SWITCHES 32450020 NI TDIRSWCH+1,TDIRJDD TURN OFF JED, DISABLE, AND A48402 32480021 TDIRJDD EQU X'F8' DISCONTINUED INPUT SWITCHES A48402 32510021 NI TDIRSWCH+2,TDIRJCLF TURN OFF JCL SWITCH 32550020 TM 12(R11),TDIRRJN TEST RJEND RECEIVED A26537 32600020 BO LRDWAIT YES RJEND PROCEES GO WAIT A26537 32650020 LRDRTL EQU * A26537 32700020 TM LCBNSWFL,LCBLST28 TEST FOR RETURN 28 TO IHKABLST 000A 32750020 BO LRDLST28 BRANCH IF SO 000A 32800020 TM LCBNSWFL,LCBSTRJE TEST FOR RETURN 0 TO IHKABLST 32850020 BO LRDRTLST BRANCH IF SO 32900020 TM TDIRSWCH+2,TDIRLWRN TEST BRANCH TO LWR SWITCH 32950020 BO LRDBRLWR BRANCH IF ON 33000020 CLI LCBTYPLN,LCBSWTCH TEST FOR SWITCHED LINE 33050020 BE LRDRTOUT BRANCH IF SWITCHED LINE 33100020 LRDRTLST EQU * 33150020 TM LCBFLG,LCB3977 TEST FOR 3977 MODEM 000D 33200020 BZ LRDRTSLT NO DO NORMAL RETURN 000D 33250020 LA R15,LRDSTSLT SET RETURN CODE TO LST FOR LOPEN 000D 33300020 B LRDRETLS FUNCTION 000D 33350020 LRDRTSLT LA R15,LRDCDLST SET RETURN (NORMAL) FOR IHKABLST 000D 33400020 LRDRETLS L R14,LRDABLST GET RETURN ADDRESS OF LINE SCHEDULER 33450020 BR R14 RETURN TO LINE SCHEDULER 33500020 SPACE 2 33550020 LRDLST28 LA R15,LRDSW278 RETURN TO SEND EOT TO 2780 ON 000A 33600020 * SWITCHED LINE 000A 33650020 B LRDRETLS RETURN TO LINE SCHEDULER 000A 33700020 SPACE 2 000A 33750020 LRDCKSWL CLI LCBTYPLN,LCBSWTCH CHECK FOR SWITCHED LINE 33800020 BNE LRDRTLST TO SET RETURN CODE FOR IHKABLST 000A 33850020 TM LCBNSWFL,LCBLST28 TEST FOR RETURN 28 TO IHKABLST 000A 33900020 BO LRDLST28 BRANCH IF SO 000A 33950020 TM LCBNSWFL,LCBERRSW TEST ERROR SWITCH 34000020 BZ LRDRTLST BRANCH IF OFF 34050020 LRDRTEOT LA R15,LRDCDEOT SET RETURN CODE FOR IHKABEOT 34100020 B LRDRETLS RETURN TO LINE SCHEDULER 34150020 SPACE 2 34200020 LRDRTOUT TM LCBNSWFL,LCBRJNDF TEST FOR RJENDF GENERATED 000A 34250020 BO LRDRTLST BRANCH IF SO 000A 34300020 LRDTSTER TM LCBNSWFL,LCBERRSW TEST ERROR SWITCH 34350020 BO LRDRTEOT BRANCH IF ON 34400020 LA R15,LRDCDSWL SET RETURN CODE FOR SWITCHED LINE 34450020 B LRDRETLS RETURN TO LINE SCHEDULER 34500020 SPACE 2 34550020 LRDBRLWR NI TDIRSWCH+2,TDIRLWRF TURN OFF BRANCH TO LWR SWITCH 34600020 LA R15,LRDCDLWR SET RETURN CODE FOR IHKABLWR 34650020 B LRDRETLS RETURN TO LINE SCHEDULER 34700020 SPACE 2 34750020 LRD2780 EQU * 34800020 LA R5,84(R5) STEP BTAM BUFFER PTR TO NEXT CARD 34950020 B LRDBTAM 35000020 SPACE 2 35050020 LRDDISCN LTR R11,R11 CHECK FOR TDIR POINTER 000A 35100020 BZ LRDREAD BRANCH IF NO TDIR POINTER 000A 35150020 OI TDIRSWCH+1,TDIRDIPN TURN ON DISCONTINUED INPUT SW 000A 35200020 B LRDREAD READ MORE INPUT 35250020 SPACE 2 35300020 LRDRESUM LTR R11,R11 CHECK FOR TDIR POINTER 000A 35350020 BZ LRDREAD BRANCH IF NO TDIR POINTER 000A 35400020 NI TDIRSWCH+1,TDIRDIPF TURN OFF DISCONTINUED INPUT SW 000A 35450020 B LRDREAD 35500020 SPACE 2 35550020 * 35600020 *********************************************************************** 35650020 * 35700020 * EOT RECEIVED IN DISCONTINUED INPUT MODE 35750020 * ISSUE READ INITIAL FOR NON-SWITCHED LINE 35800020 * ISSUE WRITE RESET AND READ CONTINUE FOR SWITCHED LN 35850020 * 35900020 *********************************************************************** 35950020 * 36000020 LRDDISCT L R7,LCBLDECB GET POINTER TO DECB FOR LINE 36050020 L R14,LRDZZAVT GET BASE OF AVT DSECT 36100020 USING IHKZZAVT,R14 BASE OF AVT DSECT 36150020 L R15,IHKZZRCS GET ADDRESS OF WARMSTART AND 36200020 * STOP BITS 36250020 TM 0(R15),LRDSTRJE TEST STOP RJE BIT 36300020 BO LRDSTOP BRANCH IF ON 36350020 CLI LCBTYPLN,LCBSWTCH CHECK FOR SWITCHED LINE 36400020 BE LRDRDTQ BRANCH IF SWITCHED LINE 36450020 CLI LCBTYPLN,LCBPTPT CHECK FOR POINT-TO-POINT LINE 36500020 BE LRDRDAGN BRANCH IF POINT-TO-POINT LINE 36550020 L R10,LCBDFTRM GET ADDRESS OF DFTRMLST IN LCB 000A 36600020 BCTR R10,0 SUBTRACT ONE TO GET ADDRESS OF 000A 36650020 * ATTRIBUTE CHAR BEFORE DFTRMLST 000A 36700020 SR R9,R9 GET ATTRIBUTE CHARACTER IN 000A 36750020 IC R9,0(R10) REGISTER 9 000A 36800020 SRL R9,5 GET LENGTH OF EACH ENTRY IN 000A 36850020 * DFTRMLST 000A 36900020 SH R9,LRD3 IGNORE ENQ AND INDEX AFTER 000A 36950020 * POLLING CHARACTER(S) 000A 37000020 L R10,DECENTRY GET ADDRESS OF CURRENT POLLING 000A 37050020 * ENTRY 000A 37100020 CHKSYN EQU * 000D 37150020 CLI 0(R10),LRDSYNC CHECK FOR SYN CHARACTER 000D 37200020 BNE OKAY NO SYN CHARACTER CONTINUE 000D 37250020 LA R10,1(R10) STEP POINTER FORWARD 2756 37300020 BCTR R9,0 DECREMENT COUNT TO DELETE SYNS 000D 37350020 B CHKSYN GO CHECK FOR ANOTHER SYN 000D 37400020 OKAY EQU * 000D 37450020 EX R9,LRDMVSEL MOVE POLLING CHARACTER(S) TO 000A 37500020 * DFTRMLST IN TERMINAL DIRECTORY 000A 37550020 LA R9,TDIRDFTA+3 GET ADDR OF DEFINE TERMINAL LIST000C 37600020 LRDRDAGN READ (7),TI,,,,(9),MF=E READ INPUT DATA 37650020 BAL R10,LRDSIO CHECK FOR SUCCESSFUL READ 37700020 BNE LRDCKRST BRANCH IF UNSUCCESSFUL 37750020 TM DECFLAGS,LRDRTPL CHECK FOR READ ENDED BY RESETPL 000A 37800020 * ON MULTI-POINT LINE 000A 37850020 BO LRDDISCT BRANCH IF SO 000A 37900020 BAL R10,LRDBUFPT GET POINTER TO START AND END 000A 37950020 * OF BTAM BUFFER 000A 38000020 CLI LCBTYPLN,LCBMULPT CHECK FOR MULTI-POINT LINE 000A 38050020 BNE LRDSTP1 BRANCH IF NOT MULTI-POINT LINE 000A 38100020 LA R5,1(R5) STEP PAST POLLING CHARACTER 000A 38150020 LRDSTP1 BAL R9,LRDCKEOT CHECK DATA LINK CONTROL CHARS. 000A 38200020 B LRDNXTCD 000A 38250020 LRDCKRST CLI DECSDECB,LRDRSTPL TEST COMPLETION CODE FOR RESETPL 38300020 * ON POINT-TO-POINT LINE 000A 38350020 BE LRDDISCT BRANCH IF 48 TO READ AGAIN 38400020 B LRDBDRD BRANCH TO RJENDF 38450020 SPACE 2 38500020 LRDRDTQ LA R9,9 SET LOOP COUNTER FOR READ ENQ 38550020 OI DECTYPE,LRDTOFLG INDICATE NO BTAM ERROR MESSAGE 000A 38600020 * FOR TIME OUT 000A 38650020 WRITE (7),TN,MF=E WRITE RESET AND GET ENQ AS RESPONSE 38700020 BAL R10,LRDSIO CHECK FOR SUCCESSFUL READ 38750020 BNE LRDCKTIM BRANCH IF UNSUCCESSFUL COMPLETION 38800020 CLI DECRESPN,LRDENQ CHECK FOR ENQ IN RESPONSE FIELD 38850020 BE LRDREAD ENQ RECEIVED DO READ CONTINUE 000E 38900020 CLI DECRESPN,LRDEOTCR EOT CHECK 000E 38950020 BE LRDRDTQ EOT RECEIVED DO WRITE EOT 000E 39000020 B LRDBDRD INVALID CHAR DO RJENDF 000E 39050020 SPACE 2 39100020 LRDRDTQR EQU * 000A 39150020 OI DECTYPE,LRDTOFLG INDICATE NO BTAM ERROR MESSAGE 000A 39200020 * FOR TIME OUT 000A 39250020 READ (7),TQ,MF=E READ ENQ 000A 39300020 BAL R10,LRDSIO CHECK FOR SUCCESSFUL READ 39350020 BE LRDREAD BRANCH IF SUCCESSFUL COMPLETION 39400020 LRDCKTIM TM DECSENS0,LRDTMOUT TEST FOR TIME OUT 39450020 BZ LRDBDRD BRANCH TO RJENDF IF NOT TIME OUT 39500020 BCT R9,LRDRDTQR REPEAT READ ENQ 7 TIMES 39550020 B LRDBDRD RJENDF AFTER EXECUTING READ ENQ 8 39600020 * TIMES 39650020 SPACE 2 39700020 LRDSIO LTR R15,R15 TEST FOR SUCCESSFUL START OF READ 39750020 BC 7,LRDBDRD BRANCH IF UNSUCCESSFUL START 39800020 LR R1,R7 GET ADDRESS OF LINE ECB 000A 39850020 L R15,LRDAADSP GET ADDRESS OF DISPATCHER 39900020 BALR R14,R15 HAS MULTIPLE WAIT 39950020 NI DECTYPE,LRDTOOFF RESET FOR BTAM ERROR MESSAGE 000A 40000020 * FOR TIME OUT 000A 40050020 CLI DECSDECB,LRD7F TEST FOR SUCCESSFUL COMPLETION 40100020 BR R10 40150020 SPACE 2 40200020 LRDSTOP OI LCBNSWFL,LCBSTRJE INDICATE RETURN OF ZERO 40250020 NI TDIRSWCH+1,TDIRDIPF TURN OFF DISCONTINUED INPUT SWITCH 40300020 XC 0(4,R5),0(R5) CLEAR EOT STX ENQ FROM BTAM BUF 000A 40350020 B LRDEOT CLEAN UP AND RETURN TO IHKABLST 40400020 SPACE 2 40450020 LRDJCLCK CLC 0(2,R3),LRDSLASH CHECK FOR JCL CARD 000C 40500020 BNE LRDSYSDT BRANCH IF NOT JCL - IT IS SYSIN DATA 40550020 * 40600020 *********************************************************************** 40650020 * 40700020 * PROCESS JCL 40750020 * CHECK FOR JOB, DD * OR DD DATA CARD 40800020 * 40850020 *********************************************************************** 40900020 * 40950020 TM TDIRSWCH,TDIRRJLG TEST FOR RJSTART AND LOGON FOUND 41000020 BC 14,LRDRJMIS BRANCH IF ONE OR BOTH MISSING 000A 41050020 TM TDIRSWCH,TDIRDDAN TEST DD * SWITCH 41100020 BC 14,LRDJCL BRANCH IF DD * SWITCH NOT ON 41150020 BAL R10,LRDSYEND BRANCH IF DD * SWITCH ON 41200020 B LRDCKTYP GO PROCESS RECORD 000C 41250020 LRDJCL LA R10,70(R3) GET STOPPING ADDRESS FOR SCAN 000C 41300020 CLI 2(R3),ASTER CHECK FOR //* (COMMENT) A22260 41350020 ASTER EQU C'*' A22260 41400020 BNE LRDNOTC NO,NOT COMMENTD A26537 41450020 TM TDIRSWCH+2,TDIRJCLN ARE WE IN JCL? A22260 41500020 BZ LRDNOJOB NO, NO JOB CARD ERROR A22260 41550020 B LRDJCLBF YES, VALID COMMENT CARD A22260 41600020 LRDNOTC EQU * A26537 41650020 L R12,OTHRBASE SET BASE FOR SUB ROUTINE A26537 41700020 BR R12 AND GO TO IT A26537 41750020 LRDDDATA OI TDIRSWCH,TDIRDDDN TURN ON DD DATA SWITCH 000C 41800020 * 41850020 *********************************************************************** 41900020 * 41950020 * DD * OR DD DATA CARD RECEIVED 42000020 * ALLOCATE AND OPEN SYSIN DATA SET 42050020 * MODIFY DD CARD 42100020 * 42150020 *********************************************************************** 42200020 * 42250020 LRDDDCRD MVC DCBDDNAM(8),LCBDDNAM PUT DDNAME OF LINE'S SYSIN DD CARD 42300020 * IN DCB 42350020 LA R11,LRDJFCB SET RETURN ADDRESS 42400020 SPACE 1 42450020 USING LRDCVT,R14 SET BASE OF CVT 000A 42500020 LRDGTUCB L R14,CVTPTR GET ADDRESS OF CVT 000A 42550020 L R1,CVTTCBP GET ADDRESS OF TCB ADDRESSES 000A 42600020 L R1,4(R1) GET ADDRESS OF TCB 000A 42650020 L R9,TCBTIO(R1) GET ADDRESS OF TIOT 000A 42700020 USING LRDTIOT1,R9 SET BASE FOR TIOT 42750020 LRDTIOT SR R10,R10 CLEAR REGISTER 10 42800020 IC R10,TIOELNGH GET LENGTH OF THIS DD ENTRY 42850020 LTR R10,R10 TEST FOR END OF DD ENTRIES IN TIOT 42900020 BNZ LRDON BRANCH IF NOT END OF DD ENTRIES 000B 42950020 * BAD RJE PROCEDURE 000B 43000020 * SYSIN DD CARD FOR LINE MISSING 000B 43050020 LRDAB987 DS 0H 000B 43100020 USING IHKZZAVT,R14 000B 43150020 L R14,LRDZZAVT 000B 43200020 L R1,IHKZZRCS 000B 43250020 OI 0(R1),LRD17ERR 000B 43300020 LRD17ERR EQU X'03' 000B 43350020 L R15,IHKZZASE 000B 43400020 BR R15 000B 43450020 USING LRDCVT,R14 000B 43500020 LRDON DS 0H 000B 43550020 CLC TIOEDDNM(8),LCBDDNAM COMPARE DDNAME TO SYSIN DATA DDNAME 43600020 BE LRDUCB BRANCH IF EQUAL 43650020 AR R9,R10 STEP TO NEXT DD ENTRY IN TIOT 43700020 B LRDTIOT 43750020 LRDUCB LA R10,TIOESTTB GET ADDRESS OF UCB ADDRESS 43800020 ST R10,LRDUCBAD STORE FOR ALLOCATE ROUTINE 43850020 BR R11 43900020 SPACE 1 43950020 LRDJFCB DS 0H 000C 44000020 L R1,LRDSVBLK GET ADDR OF BLANK AFTER DDNAME 000A 44050020 MVC 1(18,R1),0(R1) PUT BLANKS AFTER DDNAME 000A 44100020 LRDALC ST R4,LCBPARM1 STORE JECL-JCL BUFFER INDEX 000A 44150020 L R14,LRDZZAVT GET BASE OF AVT DSECT 44200020 USING IHKZZAVT,R14 SET BASE OF AVT DSECT 44250020 ST R2,IHKZZLCB STORE LCB ADDRESS 44300020 LA R1,IHKZZLCB GET ADDRESS OF PARAMETER 44350020 L R15,LRDABALC GET ADDR OF SYSIN ALLOCATION ROUTINE 44400020 BALR R14,R15 44450020 L R11,LCBTDIR RESET TERMINAL DIRECTORY ADDR 000A 44500020 B *+4(R15) BRANCH ON RETURN CODE 44550020 B LRDSETRG NORMAL RETURN 44600020 B LRDQMIOE QUEUE MANAGER I/O ERROR 44650020 B LRDSYSSP OUT OF SPACE FOR SYSIN DATA 44700020 B LRDIOALC I/O ERROR ON ALLOCATE 44750020 SPACE 2 44800020 LRDSETRG EQU * 000A 44850020 SR R3,R3 START WITH ZERO COUNT 19018 44900020 STH R3,LCBSMFCT STORE IN COUNTER FIELD 19018 44950020 L R3,LCBBUFER INITIALIZE REGISTER 3 TO START OF 45000020 LA R3,LRDDSKBF(R3) DISK BUFFER 45050020 LR R4,R3 SET REGISTER 4 TO END OF 45100020 AH R4,DCBBLKSI DISK BUFFER 45150020 B LRDNOTFL 45200020 SPACE 2 45250020 LRDSCJCL LA R1,LRDSCAN GET ADDRESS OF PARAMETER LIST 000A 45300020 L R15,LRDCCSCN GET ADDRESS OF SCAN ROUTINE 000A 45350020 BALR R14,R15 CALL SCAN TO FIND CHARACTER 000A 45400020 LTR R15,R15 TEST RETURN CODE 000A 45450020 BCR 7,R9 IF FOUND, RETURN 1654 45500020 TM TDIRSWCH+2,TDIRJCLN IS JCL SWITCH ON 1654 45550020 BZ LRDNOJOB NO, STATEMENT INVALID 1654 45600020 B LRDJCLBF IF ON, IT'S OK 1654 45650020 SPACE 2 000A 45700020 LRDDDAST OI TDIRSWCH,TDIRDDAN TURN ON DD * SWITCH 45750020 B LRDDDCRD 45800020 SPACE 2 45850020 LRDJEDSW NI TDIRSWCH+1,TDIRJEDF TURN OFF JED SWITCH 45900020 * NO JOB CARD 45950020 LRDNOJOB LA R0,LRDXMT8 GET INPUT CODE FOR IHKABXMT 000A 46000020 B LRDCLXMT CALL IHKABXMT TO SEND MESSAGE 000A 46050020 SPACE 2 46100020 * 46150020 *********************************************************************** 46200020 * 46250020 * PROCESS JOB CARD 46300020 * START NEW QUEUE ENTRY IF NO JED BEFORE JOB 46350020 * GET FAST TABLE ENTRY FOR JOB 46400020 * 46450020 *********************************************************************** 46500020 * 46550020 LRDJOBCD OI TDIRSWCH+2,TDIRJCLN TURN ON JCL SWITCH 46600020 TM TDIRSWCH+1,TDIRJEDN TEST JED SWITCH 46650020 BO LRDJEDFD BRANCH IF ON 46700020 TM LCBNSWFL,LCBNQBIT TEST FOR CARDS TO BE ENQUEUED 000A 46750020 BZ LRDJEDFD BR IF NO CARDS IN QUEUE ENTRY 000A 46800020 BAL R10,LRDWRJCL WRITE LAST RECORD AND ENQUEUE 46850020 BAL R10,LRDASGST ASSIGN/START NEW QUEUE ENTRY 46900020 LA R3,4(R3) SET POINTER TO BUFFER 000C 46950020 LRDJEDFD NI TDIRSWCH+1,TDIRJEDF TURN OFF JED SWITCH 47000020 L R1,LCBBUFER GET QUEUE MANAGER PARAM AREA ADDRESS 47050020 LH R9,LCBCHARS GET NO. OF CHARS. IN JOBNAME A22268 47100020 STH R9,LRDJOBCH(R1) SAVE NO. OF CHARS. IN JOBNAME 000A 47150020 LTR R9,R9 TEST FOR NO JOB NAME 47200020 BZ LRDINVNM BRANCH IF NO JOB NAME 47250020 CH R9,LRD8 TEST FOR JOBNAME TOO LONG 000A 47300020 BH LRDINVNM BRANCH IF MORE THAN 8 CHARACTERS 47350020 * VERIFY THAT JOB NAME STARTS WITH AN 47400020 * NATIONAL OR ALPHABETIC CHAR. A40161 47410020 CLI 2(R3),LRD$ IS 1ST CHAR OF JOBNAME A $ A40161 47420020 BE GOODNAME YES, THE JOBNAME IS VALID A40161 47430020 CLI 2(R3),LRD# IS 1ST CHAR OF JOBNAME A # A40161 47440020 BE GOODNAME YES, THE JOBNAME IS VALID A40161 47450020 CLI 2(R3),LRD@ IS 1ST CHAR OF JOBNAME A @ A40161 47460020 BE GOODNAME YES, THE JOBNAME IS VALID A40161 47470020 CLI 2(R3),LRDA CHECK FOR LOWEST ALPHABETIC 000C 47500020 BL LRDINVNM BRANCH IF NOT ALPHABETIC OR NUMERIC 47550020 CLI 2(R3),LRDZ CHECK FOR HIGHEST ALPHABETIC 000C 47600020 BH LRDINVNM BRANCH IF NUMERIC 47650020 MVC LRDCHAR(1),2(R3) MOVE FIRST CHARACTER OF JOBNAME 000C 47700020 NI LRDCHAR,LRDCLRHI ZERO HIGH ORDER 4 BITS OF CHARACTER 47750020 CLI LRDCHAR,LRDZERO CHECK FOR ZERO NUMERIC FIELD 47800020 BE LRDINVNM BRANCH IF ZERO 47850020 CLI LRDCHAR,LRDNINE CHECK NUMERIC FIELD 47900020 BH LRDINVNM BRANCH IF HIGHER THAN 9 47950020 CLI 2(R3),LRDINVCR CHECK FOR X'E1' (INVALID) 000C 48000020 BE LRDINVNM BRANCH IF EQUAL 48050020 GOODNAME EQU * THE JOBNAME IS VALID A40161 48070020 MVI QMNAM,LRDBLANK PUT BLANKS AS JOB NAME IN QUEUE 48100020 MVC QMNAM+1(7),QMNAM MANAGER PARAMETER AREA 48150020 BCTR R9,0 SUBTRACT ONE FROM CHARACTER COUNT 48200020 EX R9,LRDMVJOB MOVE JOB NAME INTO QMPA 48250020 L R15,LRDCDSCH GET ENTRY POINT OF FAST TABLE SEARCH 48300020 BALR R14,R15 CHECK FOR EMPTY ENTRY 48350020 SH R15,LRD4 TEST RETURN CODE 000A 48400020 BZ LRDJOBNM BRANCH IF EMPTY SLOT AVAILABLE 48450020 BM LRDDUPJB BRANCH IF DUPLICATE JOB NAME 48500020 * FAST TABLE IS FULL 48550020 LA R0,LRDXMT16 GET INPUT CODE FOR IHKABXMT 000A 48600020 B LRDCLXMT CALL IHKABXMT TO SEND MESSAGE 000A 48650020 SPACE 2 48700020 USING FASTAB,R1 SET BASE FOR FAST TABLE 48750020 LRDJOBNM L R15,LCBBUFER GET ADDRESS OF JOBNAME 48800020 MVC FASTNAME(8),0(R15) PUT JOB NAME IN FAST TABLE TO 48850020 * RESERVE ENTRY AND CLEAR REST OF 48900020 * ENTRY EXCEPT TWO TTRS 48950020 MVI FASTJIB,FASTIOUT CLEAR JOB INFORMATION BYTE 000B 49000020 XC FASTDSB(2),FASTDSB CLEAR FASTDSB AND FASTDSBE 49050020 L R9,LRDCDFLN GET ADDRESS OF FAST TABLE LENGTH 49100020 LH R9,0(R9) GET FAST TABLE LENGTH 49150020 SH R9,LRD18 TO SKIP CLEARING FIRST 000A 49200020 * 17 BYTES OF FAST TABLE ENTRY 49250020 EX R9,LRDCLFST CLEAR REST OF FAST TABLE ENTRY 49300020 B LRDJCLBF 49350020 USING IOPARAMS,R1 RESTORE QMPA BASE 49400020 SPACE 2 49450020 * DUPLICATE JOB NAME 49500020 LRDDUPJB LA R0,LRDXMT4 GET INPUT CODE FOR IHKABXMT 000A 49550020 B LRDCLXMT CALL IHKABXMT TO SEND MESSAGE 000A 49600020 SPACE 2 49650020 * NO JOB NAME 49700020 LRDINVNM SR R0,R0 INPUT CODE FOR IHKABXMT 000D 49750020 LRDCLXMT ST R0,LCBPARM1 STORE AS PARAMETER 000A 49800020 ST R3,LCBPARM2 STORE POINTER TO CARD 000C 49850020 LRDXMTCL ST R6,LCBPARM3 STORE PTR TO END OF BTAM BUFFER 000A 49900020 L R14,LRDZZAVT GET BASE OF AVT DSECT 000A 49950020 USING IHKZZAVT,R14 BASE OF AVT DSECT 000A 50000020 ST R2,IHKZZLCB STORE LCB ADDRESS 000A 50050020 LA R1,IHKZZLCB GET ADDRESS OF PARAMETER 000A 50100020 L R15,LRDABXMT CALL ROUTINE WHICH TRANSMITS 000A 50150020 BALR R14,R15 AN ERROR MESSAGE 000A 50200020 IHKABRET DS 0H 19018 50250020 B *+4(R15) BRANCH ON RETURN CODE 000A 50300020 B LRDEOT 000A 50350020 B LRDRELBF 000A 50400020 B LRDEBDWT RJENDF WITH ERROR MSG. A27468 50450020 B LRDEBDRD RJENDF WITH LINE ERROR A27468 50500020 B LRDWRTJC WRITE JCL BUFFER 19018 50550020 B LRDDELET DELETE QUEUE ENTRY 19018 50600020 B LRDSTRET GO SET RETURN CODE 000E 50650020 B LRDDISCT BRANCH TO DISCONTINUE FUNCTION 000E 50700020 B LRDRDTQ BRANCH TO READ ENQ FUNCTION 000E 50750020 LRDSTRET EQU * 000E 50800020 LA R10,LRDRTLST SET TO RETURN TO IHKABLST 19018 50850020 B LRDWRJCL WRITE JCL 19018 50900020 SPACE 2 50950020 LRDSYSDT TM TDIRSWCH,TDIRDDAN TEST DD * SWITCH 51000020 BC 12,LRDBLKCK BRANCH IF NOT READING DD* INPUT 000A 51050020 * 51100020 *********************************************************************** 51150020 * 51200020 * PROCESS SYSIN DATA 51250020 * 51300020 *********************************************************************** 51350020 * 51400020 LRDMVSYS CLC 0(3,R3),LRDENDDT TEST FOR /* 000C 51450020 LA R10,LRDNOTFL SET RETURN ADDRESS 51500020 BE LRDSYEND BRANCH IF FOUND 51550020 LH R7,LCBSMFCT GET NO. OF SYSIN RECORDS 19018 51600020 LA R7,1(R7) ADD ONE 19018 51650020 STH R7,LCBSMFCT STORE NEW TOTAL 19018 51700020 LA R9,80(R3) STEP DISK BUFFER POINTER 51750020 CR R9,R4 TEST FOR END OF DISK BUFFER 51800020 BL LRDNTFUL BRANCH IF BUFFER NOT FULL 51850020 SPACE 1 51900020 L R7,LCBDDECB GET DISK DECB ADDRESS FROM LCB 51950020 L R9,LCBBUFER GET ADDRESS OF BEGINNING OF 52000020 LA R9,LRDDSKBF(R9) OUTPUT BUFFER 52050020 LRDSYSWR WRITE (7),SF,,(9),MF=E WRITE BUFFER TO SYSIN DATA SET 52100020 LA R1,0(R7) GET DISK ECB ADDRESS 52150020 L R15,LRDAADSP GET ADDRESS OF DISPATCHER 52200020 BALR R14,R15 GO TO MULTIPLE WAIT 52250020 CHECK (1) 52300020 TM TDIRSWCH,TDIREOSN TEST FOR END OF SYSIN 52350020 L R3,LCBBUFER RESET REGISTER 3 TO START OF 52400020 LA R3,LRDDSKBF(R3) DISK BUFFER 52450020 BZ LRDNOTFL BRANCH IF NOT END OF SYSIN 52500020 NI TDIRSWCH,TDIREOSF TURN OFF END OF SYSIN SWITCH 52550020 LRDCLOSE CLOSE ((8)) CLOSE SYSIN DATA SET 52600020 NI TDIRSWCH,TDIRSYSF TURN OFF DD DATA AND DD * SWITCHES 52650020 L R3,LCBBUFER SET REGISTER 3 TO BEGINNING OF 52700020 LA R3,LRDQMCHN(R3) JECL AND JCL BUFFER 52750020 LH R4,LCBSMFCT GET TOTAL SYSIN COUNT 19018 52800020 CVD R4,LRDDECNO CONVERT TO DECIMAL 19018 52850020 UNPK LRDUPDEC(8),LRDDECNO+4(4) UNPACK COUNT 19018 52900020 OI LRDUPDEC+7,LRDZONE PUT 'F' IN SIGN POSITION 19018 52950020 MVC LRDSMFCD+11(6),LRDUPDEC+2 MOVE COUNT TO CARD 19018 53000020 MVI 4(R3),LRDBLANK BLANK OUT BUFFER 19018 53050020 MVC 5(79,R3),4(R3) ... 19018 53100020 MVC 19(19,R3),LRDSMFCD MOVE TO JCL BUFFER 19018 53150020 MVC 4(2,R3),LRDSLASH MOVE // 19018 53200020 L R4,LRDDEC80 INDEX FOR JCL BUFFER 19018 53250020 MVI LRDCDIND(R3),LRD1CRD INDICATE ONE CARD IN BUFFER 19018 53300020 BR R10 53350020 SPACE 2 53400020 LRDSYEND L R9,LCBBUFER SET REGISTER 9 TO START OF DISK 53450020 LA R9,LRDDSKBF(R9) BUFFER 53500020 L R7,LCBDDECB GET DISK DECB POINTER FROM LCB 53550020 SR R3,R9 GET NUMBER OF BYTES IN DISK BUFFER 53600020 LTR R3,R3 TEST FOR NO DATA IN DISK BUFFER 53650020 BZ LRDCLOSE BRANCH AROUND WRITE IF NO DATA 53700020 STH R3,DCBBLKSI SET BLOCK SIZE FOR SHORT RECORD 53750020 OI TDIRSWCH,TDIREOSN TURN ON END OF SYSIN SWITCH 53800020 B LRDSYSWR 53850020 SPACE 2 53900020 LRDBLKCK CLI 0(R3),LRDBLANK CHECK FOR BLANK IN COL. 1 000C 53950020 BNE LRDGENSY BRANCH IF NOT BLANK 000A 54000020 CLC 1(79,R3),0(R3) CHECK FOR BLANKS IN 2-80 000C 54050020 BE LRDRJF UNDEFINED OPERATION 000C 54100020 SPACE 2 000A 54150020 LRDGENSY CLC 0(3,R3),LRDENDDT TEST FOR /* 000C 54200020 BE LRDNOTFL BR IF FOUND TO GET NEXT CARD 000A 54250020 CLC 0(2,R3),LRDDOTS CHECK FOR .. IN COLS. 1 AND 2 000C 54300020 BE LRDSEQCK QUEUE JECL CARD SO READER CAN 000A 54350020 * GENERATE UNDEFINED OPERATION 000A 54400020 * MESSAGE BECAUSE COL 3 NOT BLANK 000A 54450020 TM TDIRSWCH+2,TDIRJCLN TEST JCL SWITCH 000A 54500020 BNO LRDRJF BRANCH IF NOT ON BECAUSE 000C 54550020 * NOT PROCESSING JOB 000A 54600020 OI TDIRSWCH,TDIRDDAN TURN ON DD * SWITCH 000A 54650020 BAL R15,LRDFIXR3 GET CORRECT DISK BUFFER POINTER 000C 54700020 MVC 4(8,R10),LRDGNSYS PUT '//SYSIN ' IN JECL-JCL BUF 000A 54750020 MVC 12(72,R10),11(R10) PUT BLANKS IN COLUMNS 9-80 000A 54800020 TM TDIRSWCH+2,TDIRMCHN TEST FOR CPU OR 2780 000A 54850020 BZ LRDSYS27 BRANCH IF 2780 000A 54900020 TM TDIRRB,TDIRPNRN COMPRESSING TERMINAL? 000C 54950020 BNO LRDNOTCE NO, USE REGULAR STEPPING BACK 000C 55000020 BCTR R5,0 JUST BACK UP ONE BYTE TO AVOID 000C 55050020 * BOTH STEPPING BEYOND BEGINNING 000C 55100020 * OF BUFFER AND OVERLAYING INFO 000C 55150020 MVI 0(R5),X'01' INDICATE THAT WE STEPPED BACK 1 000C 55200020 B LRDGNSY2 CONTINUE 000C 55250020 LRDNOTCE DS 0H 000C 55300020 SH R5,EIGHTY BACK UP BTAM BUFFER POINTER BY 000C 55350020 * ONE CARD SO FIRST SYSIN CARD IS 000A 55400020 * NOT SKIPPED 000A 55450020 LRDGNSY2 MVC DCBDDNAM(8),LCBDDNAM PUT DDNAME OF LINE'S SYSIN 000A 55500020 * DD CARD IN DCB 000A 55550020 BAL R11,LRDGTUCB GET ADDRESS OF UCB ADDRESS 000A 55600020 SR R11,R11 000C 55650020 STH R11,LCBPARM3+2 000C 55700020 B LRDALC GO TO ALLOCATE ROUTINE 000A 55750020 LRDSYS27 SH R5,LRD84 BACK UP BTAM BUFFER POINTER BY 000A 55800020 * ONE CARD SO FIRST SYSIN CARD IS 000A 55850020 * NOT SKIPPED 000A 55900020 B LRDGNSY2 000A 55950020 LRDRJWT LA R1,DUMECB LOOP TO WAIT FOR OTHER LINES A48402 55960021 L R15,LRDAADSP RJENDF TO BE QUEUED A48402 55970021 BALR R14,R15 A48402 55980021 B LRDRJTST A48402 55990021 SPACE 2 000A 56000020 * 56050020 *********************************************************************** 56100020 * 56150020 * ERROR HANDLING SECTION 56200020 * 56250020 *********************************************************************** 56300020 * 56350020 * EXLST ROUTINE 56400020 LRDOUTSP OI TDIRRB,TDIREXLN TURN ON EXLST SWITCH 56450020 LA R15,1 SET RETURN CODE FOR EOV ROUTINE 56500020 BR R14 RETURN TO EOV ROUTINE WHICH THEN 56550020 * COMES TO MY SYNAD EXIT 56600020 SPACE 2 56650020 * OUT OF SPACE FOR SYSIN 56700020 LRDSYSSP NI TDIRSWCH,TDIRSYSF TURN OFF DD DATA AND DD * SWITCHES 56750020 LRDSYSP2 LA R0,LRDXMT20 GET INPUT CODE FOR IHKABXMT 000A 56800020 B LRDCLXMT CALL IHKABXMT TO SEND MESSAGE 000A 56850020 SPACE 2 56900020 * OUT OF SPACE FOR SYSIN OR 56950020 * SYSIN LIMIT EXCEEDED OR 57000020 * I/O ERROR ON SYSIN DATA SET 57050020 LRDSYNAD TM TDIRRB,TDIREXLN TEST EXLST SWITCH 57100020 BO LRDSYSP2 BRANCH IF ON - OUT OF SPACE 57150020 L R9,DCBDEBAD GET ADDRESS OF DEB FOR SYSIN 57200020 CLI DEBNMEXT(R9),LRDNMEXT TEST NUMBER OF EXTENTS IN DEB 57250020 BL LRDDSKER BRANCH IF REALLY DISK I/O ERROR 57300020 * SYSIN LIMIT EXCEEDED 57350020 LA R0,LRDXMT12 GET INPUT CODE FOR IHKABXMT 000A 57400020 B LRDCLXMT CALL IHKABXMT TO SEND MESSAGE 000A 57450020 SPACE 2 57500020 * OUT OF SPACE FOR QUEUE ENTRY 57550020 LRDQMSPA LA R0,LRDXMT24 GET INPUT CODE FOR IHKABXMT 000A 57600020 B LRDCLXMT CALL IHKABXMT TO SEND MESSAGE 000A 57650020 SPACE 2 57700020 * I/O ERROR ON ASSIGN/START 57750020 LRDQMIOA LA R0,LRDXMT28 GET INPUT CODE FOR IHKABXMT 000A 57800020 B LRDCLXMT CALL IHKABXMT TO SEND MESSAGE 000A 57850020 SPACE 2 57900020 * I/O ERROR ON Q MGR NOT ASSIGN/START 57950020 LRDQMIOE CLC LCBWORKA,LRDSPENT CHECK FOR ENTRY AT IHKABRJF INSTEAD 58000020 * OF AT IHKABLRD 58050020 BE LRDNOTQD BRANCH IF ENTERED AT IHKABRJF 58100020 LA R0,LRDXMT32 GET INPUT CODE FOR IHKABXMT 000A 58150020 B LRDCLXMT CALL IHKABXMT TO SEND MESSAGE 000A 58200020 SPACE 2 58250020 * I/O ERROR ON ALLOCATE 58300020 LRDIOALC NI TDIRSWCH,TDIRSYSF TURN OFF DD DATA AND DD * SWITCHES 58350020 LRDIOSYS LA R0,LRDXMT36 GET INPUT CODE FOR IHKABXMT 000A 58400020 B LRDCLXMT CALL IHKABXMT TO SEND MESSAGE 000A 58450020 SPACE 2 58500020 * I/O ERROR ON SYSIN DATA SET 58550020 LRDDSKER L R3,LCBBUFER RESET REGISTER 3 TO START OF 58600020 LA R3,LRDDSKBF(R3) DISK BUFFER 58650020 BAL R11,LRDGTUCB GET ADDRESS OF UCB ADDRESS 58700020 L R11,LCBTDIR RESET WITH TERMINAL DIRECTORY ADDR 58750020 B LRDIOSYS WRITE MESSAGE TO CENTRAL AND REMOTE 58800020 SPACE 2 000C 58850020 * UNPACKED RECORD REC'D FOR PACKED000C 58900020 LRDGOOF2 L R7,LCBLDECB GET DECB ADDRESS 000C 58950020 WRITE (7),TN,MF=E WRITE EOT 000C 59000020 BAL R10,LRDSIO GO TO CHECK ON I/O 000C 59050020 LA R10,LRDCKSYS SET TO RETURN TO CHECK SYSIN 000C 59100020 B LRDWMSRT BRANCH TO RJENDF 000C 59150020 SPACE 2 59200020 * BTAM READ FAILED 59250020 LRDEBDRD DS 0H A47967 59300021 LRDBDRD LTR R11,R11 TEST FOR TERMINAL DIRECTORY POINTER 59350020 BZ LRDDELET BRANCH IF NO POINTER 59400020 LA R10,LRDCKSYS SET RETURN ADDRESS 59450020 SPACE 1 59500020 * LINE FAILURE 59550020 L R5,DECAREA LOAD BUFF POINTER A24704 59600020 CLC 0(3,R5),LRDSTKUN HAS 2770 STACKER UNLOAD BUTON A35897 59610020 * BEEN PRESSED. A35897 59620020 BE LRDDISCT YES, ALLOW TIME FOR THE A35897 59630020 * STACKER TO BE UNLOADED A35897 59640020 CLC 0(3,R5),LRDCDJAM CHECK FOR EOT STX ENQ AFTER A24704 59650020 * ERROR WHICH MEANS CARD JAM AT A24704 59700020 * 2780 A24704 59750020 ST R5,0(R5) PREVENT LOOP IF TERM. OFFLINE A24712 59800020 BE LRDDISCT BRANCH IF SO TO GIVE TIME FOR A24704 59850020 * JAM TO BE CORRECTED A24704 59900020 LRDUSER L R9,LRDCDSOC GET RJETABLE ADDRESS 59950020 L R1,LCBLDECB GET DECB ADDRESS FOR USER 60000020 L R15,LRDUSREX(R9) GET LINE ERROR USER EXIT ADDRESS 60050020 BALR R14,R15 BRANCH TO USER EXIT OR DUMMY 60100020 LRDWMSRT NI TDIRSTAT,TDIRNQJM TURN OFF ENQUEUE JOBS AND ENQUEUE 60150020 * MESSAGES BITS 60200020 OI TDIRSTAT,TDIRDQNN SET DEQUEUE NOTHING BIT 60250020 OI LCBNSWFL,LCBRJNDF INDICATE RJENDF GENERATED 000A 60300020 NI TDIRSWCH,TDIRRJLF TURN OFF RJSTART AND LOGON SWITCHES 60350020 NI TDIRSWCH+2,TDIRLWRF TURN OFF BRANCH TO LWR SWITCH 60400020 L R14,LRDZZAVT GET BASE OF AVT DSECT 60450020 L R15,IHKZZECB GET ADDRESS OF ECBLIST OF IHKCCPLM 60500020 MVI 0(R15),LRDPOST POST THE MESSAGE ECB 60550020 MVI 4(R15),LRDPOST POST THE JOB ECB 60600020 USING LRDCVT,R14 RESET BASE OF CVT 60650020 BR R10 60700020 SPACE 1 60750020 LRDCKSYS DS 0H GENERATE RJENDF 19018 60800020 LA R0,LRDXMT64 OFFSET FOR IHKABXMT 19018 60850020 SR R4,R4 INITIALIZE REG 4 19018 60900020 B LRDCLXMT CALL IHKABXMT 19018 60950020 SPACE 2 61000020 * WRITE WAS UNSUCCESSFUL 61050020 LRDEBDWT DS 0H A47967 61100021 LRDBADWT LTR R11,R11 CHECK FOR TERMINAL DIRECTORY POINTER 61150020 BZ LRDNOTRM BRANCH IF NO TDIR POINTER 61200020 TM TDIRSWCH,TDIRRJFN TEST NO RJENDF SWITCH 61250020 BO LRDNORJF BRANCH IF ON 61300020 L R9,LCBBUFER GET ADDRESS OF LAST 79 BYTES OF 000A 61350020 LA R9,LRDMSGBF(R9) THE OUTPUT BUFFER 000A 61400020 BAL R15,LRDFIXR3 GET CORRECT DISK BUFFER POINTER 000C 61450020 MVC 4(10,R10),LRDDOTS PUT '.. RJENDF ' ON CARD 61500020 MVC 14(60,R10),11(R9) PUT MESSAGE ON RJENDF CARD 61550020 BAL R10,LRDUSER GO TO USER EXIT AND SET RJENDF BITS 61600020 LR R9,R3 GET ADDRESS OF JECL AND JCL BUFFER 61650020 LA R0,LRDXMT68 OFFSET FOR IHKABXMT 19018 61700020 B LRDCLXMT CALL IHKABXMT 19018 61750020 LRDNORJF NI TDIRSWCH,TDIRRJFF TURN OFF NO RJENDF SWITCH 61800020 B LRDRELBF 61850020 LRDNOTRM DS 0H NO TDIR POINTER 19018 61900020 LA R0,LRDXMT72 OFFSET FOR IHKABXMT 19018 61950020 B LRDCLXMT CALL IHKABXMT 19018 62000020 LRDDELET L R1,LCBBUFER GET QMPA ADDRESS 62050020 SR R15,R15 IS ADDRESS OF EXTENSION A47439 62090021 C R15,QMPCL OF QMPA ZERO A47439 62130021 BE LRDRELBF YES - SKIP DELETE A47439 62170021 ST R15,QMPCL NO - ZERO IT FOR THE NEXT TIME A47439 62210021 MVI QMPOP,QMDELE STORE DELETE CODE 62250020 BAL R9,LRDQMNGR DELETE 000A 62300020 BC 7,LRDQMIOE BRANCH IF I/O ERROR 62350020 B LRDRELBF 62400020 SPACE 2 000A 62450020 LRDNOTQD LA R15,LRDCDNRC SET RETURN CODE FOR RJENDC OR RJENDF 62500020 * NOT QUEUED 62550020 B LRDRETLS RETURN TO LINE SCHEDULER 62600020 SPACE 4 000C 62650020 LRDUNPK DS 0H SUBROUTINE TO UNPACK INPUT 000C 62700020 TM TDIRSWCH,TDIRSYSN ARE WE IN SYSIN? 000C 62750020 BNZ LRDINSYS YES, DON'T CHANGE R3 000C 62800020 L R1,LCBBUFER GET QMPA ADDRESS 000C 62850020 LA R3,QMCHN GET DISK BUFFER POINTER 000C 62900020 LA R3,4(R3,R4) GET ADDRESS OF CORRECT RECORD 000C 62950020 LRDINSYS DS 0H 000C 63000020 TM TDIRRB,TDIRPUPN WAS UNPACK SELECTED? 000C 63050020 BO LRDUNP BRANCH IF SO 000C 63100020 MVC 0(80,R3),0(R5) MOVE RECORD TO OUTPUT BUFFER 000C 63150020 BR R14 RETURN 000C 63200020 LRDUNP DS 0H 000C 63250020 CLC 0(2,R5),LRDDOTS HAS REMOTE SENT AN UNPACKED CARD000C 63300020 BE LRDGOOF2 YES, RJENDF THE TERMINAL 000C 63350020 ST R5,LCBPARM2 STORE INPUT ADDRESS 000C 63400020 ST R3,LCBPARM3 STORE OUTPUT ADDRESS 000C 63450020 LR R1,R2 GET LCB ADDRESS 000C 63500020 L R15,LRDADUPK GET UNPACK ENTRY POINT ADDRESS 000C 63550020 L R15,0(R15) GET UNPACK ENTRY POINT 000C 63600020 BR R15 GO UNPACK RECORD 000C 63650020 SPACE 4 000C 63700020 LRDFIXR3 DS 0H 000C 63750020 L R1,LCBBUFER GET QMPA ADDRESS 000C 63800020 LA R3,QMCHN GET DISK BUUFER ADDRESS 000C 63850020 LR R10,R3 SAVE ADDRESS 000C 63900020 AR R10,R4 ADD BUFFER INDEX (0 OR 80) 000C 63950020 BR R15 RETURN 000C 64000020 *****************************************************************A26537 64050020 * THIS ROUTINE READS UNITIL AN EOT IS RECEIVED. *A26537 64100020 * IT THEN HOLDS UP LINE I/O OPERATION UNTIL THE RJEND IS *A26537 64150020 * PROCESSED. AFTER THE RJEND MESSAGE IS SENT THE LINE IS *A26537 64200020 * AGAIN CONDITIONED TO PROCESS MORE INPUT *A26537 64250020 *****************************************************************A26537 64300020 RJENDR EQU * A26537 64350020 L R7,LCBLDECB LOADS LINE DECB POINTER A26537 64400020 L R5,DECAREA LOADS POINTER TO BUFFER A26537 64450020 SR R0,R0 A26537 64500020 ST R0,0(0,R5) STORE ZERO IN FIRST WORD OF A26537 64550020 * BUFFER SO CHECK FOR EOT CAN BEA26537 64600020 * MADE A26537 64650020 READ (7),TRV,MF=E A26537 64700020 BAL R10,LRDSIO CHECK COMPLETION CODE A26537 64750020 BNE SKFLUSH DONT FLUSH TO EOT ON ERROR A26537 64800020 CLI 0(R5),LRDEOTCR CHECK IF EOT RECEIVED A26537 64850020 BNE RJENDR NO READ TILL WE GET IT A26537 64900020 SKFLUSH EQU * A26537 64950020 MVC LRDXMT12(4,R3),LCBDDECB MOVE IN ECB TO BE POSTEDA26537 65000020 X R4,LRDDEC80 SET JCL BUFFER INDEX TO 80 OR 0A26537 65050020 L R1,LCBBUFER GET QMPA ADDRESS A26537 65100020 LA R15,QMCHN SET POINTER TO DISK BUFFER A26537 65150020 STC R4,LRDCDIND(R15) INDICATE 1 OR 2 CARDS IN BUFF A26537 65200020 OI 12(R11),TDIRRJN SET RJEND RECEIVED FLAG A26537 65250020 B LRD1130 QUEUE RJEND COMMAND A40166 65300020 LRDWAIT EQU * A26537 65350020 NI 12(R11),TDIROFF TURN OFF RJEND RECEIVED A26537 65400020 L R1,LCBDDECB LOAD DISK ECB POINTER A26537 65450020 MVI 0(R1),LRDZERO SET OFF COMP BIT IN ECB A26537 65500020 ST R1,16(R3) PUT POINTER IN BUFFER A26537 65550020 L R15,LRDAADSP GET POINTER TO DISPATCHER A26537 65600020 BALR R14,R15 A26537 65650020 B LRDRTL RETURN TO IHKABLST A26537 65700020 SPACE 4 000C 65750020 *********************************************************************** 65800020 * 65850020 * EXECUTED INSTRUCTIONS 65900020 * 65950020 *********************************************************************** 66000020 * 66050020 LRDMVJOB MVC QMNAM(0),2(R3) MOVE JOBNAME INTO QMPA 000C 66100020 LRDMVSEL MVC TDIRDFTA+3(0),0(R10) TO MOVE POLLING CHARACTERS TO 000C 66150020 * DFTRMLST IN TERMINAL DIRECTORY 000A 66200020 USING FASTAB,R1 SET BASE FOR FAST TABLE ENTRY 66250020 LRDCLFST XC FASTALT(0),FASTALT CLEAR END OF FAST TABLE ENTRY 66300020 SPACE 2 66350020 * 66400020 *********************************************************************** 66450020 * 66500020 * READ ONLY MODEL DCB FOR SYSIN DATA SETS 66550020 * IN REAL DCB, DDNAME AND BLKSIZE ARE FILLED IN 66600020 * FROM LINE SYSIN DD CARD 66650020 * 66700020 *********************************************************************** 66750020 * 66800020 LRDSYSDD DCB DSORG=PS,MACRF=(W),DEVD=DA,LRECL=80,RECFM=FB, X66850020 EXLST=LRDEXLST,SYNAD=LRDSYNAD, X66900020 DDNAME=LRDAPR03 000A 66950020 SPACE 2 67000020 * 67050020 *********************************************************************** 67100020 * 67150020 * CONSTANTS AND DSECTS 67200020 * 67250020 *********************************************************************** 67300020 LRDSMFCD DC C'SPACE=(80,(000000))' SPACE PARM. FOR SMF COUN 19018 67350020 * 67400020 LRDSYNC EQU X'32' CLOC SYNC CHARACTER 000D 67450020 * PARAMETER LIST FOR IHKCAVER 67500020 * (COMMAND INTERPRETER) 67550020 LRDCDOPR DS F CODE AND ADDRESS OF OPERATION 67600020 LRDCDBEG DS F BEGINNING ADDRESS OF CARD IMAGE 67650020 LRDCTDIR DS F TERMINAL DIRECTORY POINTER 67700020 LRDADUPK DC V(IHKADUPK) ADDRESS OF ADDRESS OF UNPACK 000C 67750020 LRDSTKUN DC X'10022D' DLE,STX,ENQ-2770 STCKR UNLOAD M6294 67800020 LRDLCBAD DC A(IHKCDLCB) ADDR. OF FIRST LCB A21657 67850020 * THESE NEXT TWO ADDRESSES MUST BE CONTIGUOUS. A21657 67900020 LRDLINES DC A(IHKCDNOL) ADDR. OF NO. OF LINES A21657 67950020 DC A(IHKCDLGL) ADDR. OF LCB LENGTH A21657 68000020 EXTRN IHKCDLCB,IHKCDNOL,IHKCDLGL A21657 68050020 SPACE 2 68100020 DUMECB DS 0F A48402 68110021 DC X'40000000' A48402 68120021 SPACE 3 19018 68150020 * NOTE: ALL THE FOLLOWING CONSTANTS ARE DSECTED IN EITHER 19018 68200020 * IHKABXMT, IHKABALC, OR IHKCHALC. THEREFORE, IF ANY 19018 68250020 * CHANGES ARE MADE, THESE DSECTS MUST ALSO BE CHANGED. 19018 68300020 SPACE 1 19018 68350020 IHKABXCN DS 0D START OF DSECT IN IHKABXMT 19018 68400020 * PARAMETER LIST FOR IHKCBLDM (BLDMSG) 68450020 LRDBLDM DC X'80000000' BUILD BUT DO NOT ENQUEUE MESSAGE 68500020 LRDBOFS DC X'0000' MESSAGE OFFSET 68550020 LRDBPMNO DS C NUMBER OF MESSAGE PARAMETER CHARS. 68600020 LRDBPARM DS CL24 MESSAGE PARAMETER CHARACTERS 68650020 SPACE 2 68700020 CNOP 0,4 68750020 * PARAMETER LIST FOR IHKCCSCN (SCAN) 68800020 LRDSCAN DC H'0' MAXIMUM SCAN LENGTH OR ZERO 68850020 LRDSBLNK DC H'0' TO SEARCH FOR FIRST NON-BLANK CHAR. 68900020 LRDSADDR DS F STARTING ADDRESS FOR SCAN 68950020 LRDSSTOP DS F STOPPING ADDRESS FOR SCAN 69000020 LRDSCHAR DC C' ' TO STOP ON FIRST BLANK CHARACTER 69050020 DC C'),' OR RIGHT PAREN OR COMMA 000C 69100020 SPACE 2 69150020 LRDSYSIN EQU 39 SYSIN QUEUE NUMBER 69200020 LRD2TTRS EQU X'20' TO ASSIGN TWO TTR'S 69250020 LRDWR1AS EQU X'11' WRITE ONE RECORD AND ASSIGN ONE TTR 69300020 LRDWR1 EQU X'01' TO WRITE ONE RECORD 69350020 LRD1CRD EQU 80 TO INDICATE ONE CARD IN JCL BUFFER 69400020 LRDNOCRD EQU X'10' INDICATE NO CARDS IN JCL BUFFER 69450020 TCBTIO EQU 12 DISPLACEMENT FOR TIOT ADDRESS 000A 69500020 * IN TCB 000A 69550020 DEBNMEXT EQU 16 BYTE IN DEB FOR NUMBER OF EXTENTS 69600020 DEBUCBAD EQU 32 DISPLACEMENT FOR UCB ADDRESS IN DEB 69650020 LRDNMEXT EQU 16 MAXIMUM NUMBER OF EXTENTS 69700020 LRDUSREX EQU 16 LINE ERROR USER EXIT DISPLACEMENT 69750020 LRDEOTCR EQU X'37' EOT 69800020 LRDENQ EQU X'2D' ENQ 69850020 LRDBLANK EQU C' ' TO PUT BLANKS IN A FIELD 69900020 LRDCHAR1 EQU C'1' TO INDICATE REMOTE MESSAGE 000A 69950020 LRD7F EQU X'7F' GOOD COMPLETION CODE FOR I/O 70000020 LRDRSTPL EQU X'48' COMPLETION CODE AFTER RESETPL 70050020 LRDRTPL EQU X'04' DECB STATUS FLAG AFTER RESETPL 000A 70100020 LRDTOFLG EQU X'40' TO INDICATE IN DECTYPE NO BTAM 000A 70150020 * ERROR MESSAGE FOR TIME OUT 000A 70200020 LRDTOOFF EQU X'BF' TO RESET DECTYPE FOR BTAM ERROR 000A 70250020 * MESSAGE FOR TIME OUT 000A 70300020 LRDTMOUT EQU X'01' TO CHECK FOR TIME OUT IN DECSENS0 70350020 LRDRJSCD EQU 8 RJSTART CODE FOR IHKCAVER 70400020 LRDLGNCD EQU 4 LOGON CODE FOR IHKCAVER 70450020 LRDZERO EQU 0 70500020 LRDOFS13 EQU 13 LINE ERROR 70550020 LRDOFS20 EQU 20 INVALID OPERATION - RJENDC OR RJENDF 70600020 LRD15CHR EQU 15 15 MESSAGE PARAMETERS 70650020 LRDCDLST EQU 0 RETURN CODE FOR IHKABLST 70700020 LRDSTSLT EQU 32 RETURN CODE FOR LOPEN FUNCTION 000D 70750020 LRDCDEOT EQU 8 RETURN CODE FOR IHKABEOT 70800020 LRDCDLWR EQU 12 RETURN CODE FOR IHKABLWR 70850020 LRDCDNRC EQU 20 RETURN CODE FOR RJENDC OR RJENDF 70900020 * NOT QUEUED 70950020 LRDCDSWL EQU 24 RETURN CODE FOR SWITCHED LINE 71000020 LRDSW278 EQU 28 RETURN TO IHKABLST TO SEND EOT 000A 71050020 * TO 2780 ON SWITCHED LINE 000A 71100020 LRDXMT0 EQU 0 INVALID JOBNAME 000A 71150020 LRDXMT4 EQU 4 DUPLICATE JOBNAME 000A 71200020 LRDXMT8 EQU 8 NO JOB CARD 000A 71250020 LRDXMT12 EQU 12 SYSIN LIMIT EXCEEDED 000A 71300020 LRDXMT16 EQU 16 MAX JOBS EXCEEDED 000A 71350020 LRDXMT20 EQU 20 OUT OF SPACE - SYSIN 000A 71400020 LRDXMT24 EQU 24 OUT OF SPACE - SYS1.SYSJOBQE 000A 71450020 LRDXMT28 EQU 28 I/O ERROR ON ASSIGN/START 000A 71500020 LRDXMT32 EQU 32 I/O ERROR ON Q MGR NOT A/S 000A 71550020 LRDXMT36 EQU 36 I/O ERROR ON ALLOCATE OR SYSIN 000A 71600020 LRDXMT40 EQU 40 INVALID TERMID 000A 71650020 LRDXMT44 EQU 44 INVALID RJSTART OR LOGON 000A 71700020 LRDXMT48 EQU 48 INVALID OPERATION - RJENDC OR F 000A 71750020 LRDXMT52 EQU 52 RJSTART OR LOGON REQUIRED 000A 71800020 LRDXMT56 EQU 56 UNDEFINED KEYWORD 000C 71850020 LRDXMT60 EQU 60 ILLEGAL KEYWORD PARAMETER 000C 71900020 LRDXMT64 EQU 64 OFFSET 64 - LRDGENJF 19018 71950020 LRDXMT68 EQU 68 OFFSET FOR IHKABXMT - LRDGNRF 19018 72000020 LRDXMT72 EQU 72 OFFSET 72 - LRDWRTD 19018 72050020 ITBCHAR EQU X'40' BIT SET FOR ITB MODE 000E 72100020 LRDQMCHN EQU 44 DISPLACEMENT OF JECL-JCL BUFFER 72150020 LRDDSKBF EQU 48 DISPLACEMENT FOR DISK BUFFER 000A 72200020 LRDRELTD EQU 164 DISPLACEMENT FOR RELATIVE TDIR PTR 72250020 LRDCDIND EQU 168 DISPLACEMENT FOR CARD INDICATOR 72300020 LRDSCDHF EQU 200 DISPLACEMENT FOR SECOND HALF OF BUF 72350020 LRDMSGBF EQU 373 DISPLACEMENT FOR MESSAGE IN BUFFER 72400020 LRDJOBCH EQU 448 DISPLACEMENT FOR NUMBER OF 000A 72450020 * CHARACTERS IN JOBNAME 000A 72500020 LRDPOST EQU X'40' TO POST THE ECB'S OF IHKCCPLM 72550020 LRDABCLS EQU 19 TO CHECK FOR RJENDF WITH ABNORMAL 72600020 * CENTRAL CLOSEDOWN MESSAGE 72650020 LRDNOMSG EQU X'FF' FOR RJENDF WITH NO MESSAGE 000A 72700020 LRDSTRJE EQU X'80' TO TEST STOP RJE BIT 72750020 LRDZONE EQU X'F0' ZONE FOR NUMBERS 19018 72800020 LRDA EQU C'A' LOWEST ALPHABETIC CHARACTER 72850020 LRDZ EQU C'Z' HIGHEST ALPHABETIC CHARACTER 72900020 LRDCLRHI EQU X'0F' TO ZERO HIGH ORDER 4 BITS 72950020 LRDNINE EQU X'09' TO CHECK NUMERIC FIELD 73000020 LRDINVCR EQU X'E1' TO CHECK FOR INVALID CHARACTER 73050020 LRD# EQU C'#' VALID CHAR IN JOBNAME A40161 73060020 LRD$ EQU C'$' VALID CHAR IN JOBNAME A40161 73070020 LRD@ EQU C'@' VALID CHAR IN JOBNAME A40161 73080020 SPACE 2 73100020 LRDENDDT DC CL3'/*' /* CARD FOR END OF SYSIN DATA 73150020 LRDDOTS DC CL3'..' TO CHECK FOR JECL CARD 73200020 LRDRJNDF DC C'RJENDF ' 73250020 LRDRJSTT DC C'RJSTART ' 73300020 LRDLOGON DC C'LOGON ' 73350020 LRDCONT DC C'CONTINUE ' 73400020 LRDJED DC C'JED ' 73450020 LRDLOGOF DC C'LOGOFF ' 73500020 LRDRJEND DC C'RJEND ' 73550020 LRDDOTRC DC CL3'..' TO BUILD RJENDC CARD 73600020 LRDRJNDC DC C'RJENDC ' 73650020 LRDJOB DC C'JOB ' 000A 73700020 LRDDATA DC C'DATA ' TO TEST FOR DD DATA CARD 000A 73750020 LRDDD DC C'DD ' TO TEST FOR DD CARD 000A 73800020 LRDGNSYS DC C'//SYSIN ' TO GENERATE DD * CARD 000A 73850020 LRDCHAR DS C TO VERIFY ALPHABETIC CHARACTER 73900020 SPACE 73950020 IHKABCON DS 0F START OF DSECT IN IHKABALC 000A 74000020 LRDSPENT DC F'0' TO TEST FOR SPECIAL ENTRY - IHKABRJF 74050020 LRDSLASH DC CL3'//' TO CHECK FOR JCL CARD AND 74100020 * TO HELP BUILD SYSIN DD CARD 74150020 LRDTASK DC C'RJETASK ' JOB NAME FOR QMPA IF ONLY JECL 74200020 SPACE 1 74250020 LRDHEADR DC X'01' SOH 74300020 DC C'3310060' HEADER FOR CPU 74350020 DC X'26' ETB 74400020 LRDDLSTX DC X'1002' DLE STX 74450020 LRDSOHD DC X'01' SOH 74500020 DC C'D' MEANS DISCONTINUED INPUT 74550020 LRDSOHR DC X'01' SOH 74600020 DC C'R' MEANS RESUME NORMAL INPUT 74650020 LRDCDJAM DC X'37022D' EOT STX ENQ CHECK FOR CARD JAM A24704 74700020 SPACE 1 74750020 LRDCHARS DS H NO. OF CHARS IN JOBNAME/DDNAME 000A 74800020 LRD3 DC H'3' TO IGNORE ENQ AND INDEX AFTER 000A 74850020 * POLLING CHARACTER(S) 000A 74900020 LRD4 DC H'4' 000A 74950020 LRD8 DC H'8' TO TEST LENGTH OF JOBNAME 000A 75000020 LRD18 DC H'18' 000A 75050020 LRD84 DC H'84' TO BACK UP BTAM BUFFER POINTER 000A 75100020 LRD200 DC H'200' THRESHOLD FOR AVAIL Q MGR REC. 000A 75150020 LRDUCBAD DS F WILL HAVE ADDRESS OF UCB ADDRESS 75200020 LRDDEC80 DC F'80' TO INDEX JECL-JCL BUFFER 75250020 TDIROFF EQU X'BF' FLAG TO TURN OFF RJEND RECEIVEDA26537 75300020 TDIRRJN EQU X'40' SET ON RJEND RECEIVED FLAG A26537 75350020 EIGHTY EQU LRDDEC80+2 HALFWORD OF 80 000D 75400020 LRDSVBLK DS F TO SAVE ADDR OF BLANK AFTER DDNAME 75450020 SPACE 75500020 LRDCCSCN DC V(IHKCCSCN) ENTRY POINT OF SCAN 75550020 LRDAADSP DC V(IHKAADSP) ENTRY POINT OF DISPATCHER 75600020 LRDCAINT DC V(IHKCAVER) ENTRY POINT OF COMMAND INTERPRETER 75650020 LRDCBLDM DC V(IHKCBLDM) ENTRY POINT OF BUILD MESSAGE 75700020 LRDCDFMR DC V(IHKCDFMR) ENTRY POINT OF FAST TABLE MANAGER 75750020 LRDCDSCH DC V(IHKCDSCH) ENTRY POINT OF FAST TABLE SEARCH 75800020 LRDABALC DC V(IHKABALC) ENTRY POINT OF SYSIN ALLOCATION RTN 75850020 LRDABLST DC V(IHKABLST) ENTRY POINT OF LINE SCHEDULER 75900020 LRDABXMT DC V(IHKABXMT) ENTRY POINT OF ROUTINE WHICH 000A 75950020 * TRANSMITS AN ERROR MESSAGE 000A 76000020 LRDABLRD DC A(IHKABLRD+2) TO SET BASE REGISTER 76050020 LRDCDFLN DC A(IHKCDFLN) ADDRESS OF LENGTH OF FAST TABLE 76100020 LRDCDSOC DC A(IHKCDSOC) RJETABLE ADDRESS 76150020 LRDCDTDR DC A(IHKCDTDR) START OF TERMINAL DIRECTORY ENTRIES 76200020 LRDZZAVT DC A(IHKCACOM) ADDRESS OF AVT CONSTANTS 76250020 SPACE 2 000A 76300020 LRDEXLST DC X'88' 000A 76350020 DC AL3(LRDOUTSP) OUT OF SPACE ROUTINE 000A 76400020 CNOP 0,8 19018 76450020 LRDUPDEC DS 2F FOR UNPACKED DECIMAL 19018 76500020 LRDDECNO DS 2F FOR PACKED DECIMAL 19018 76550020 OTHRBASE DC A(LRDNOTCM) BASE FOR FOR DD CARD PROCESSINGA26537 76600020 DROP 12 76650020 SUBASE EQU 12 A26537 76700020 USING *,SUBASE A26537 76750020 LRDNOTCM DS 0H A26537 76800020 ST R10,LRDSSTO STORE IN PARAMETER LIST A26537 76850020 LA R10,2(R3) GET STARTING ADDRESS FOR SCAN A26537 76900020 ST R10,LRDSADD STORE IN PARAMETER LIST A26537 76950020 MVI LRDSBLN+1,LRDFSTB TO SEARCH FOR FIRST BLANK CHARA26537 77000020 BAL R9,LRDSCJC SCAN TO BLANK CHARACTER A26537 77050020 ST R1,LRDSADD STORE STARTING ADDRESS FOR A26537 77100020 * SCAN A26537 77150020 L R14,LRDSVBL LOAD ADDRESS OF PTR TO BLANK A26537 77200020 ST R1,0(R14) PUT ADDRESS IN THAT AREA A26537 77250020 SR R1,R10 SUBTRACT STARTING ADDRESS OF A26537 77300020 * NAME A26537 77350020 * FROM END TO GET NUMBER OF A26537 77400020 * CHARACTERS A26537 77450020 STH R1,LCBCHARS SAVE NUMBER OF CHARACTERS A22268 77500020 MVI LRDSBLN+1,X'00' SEARCH FOR NON BLANK CHARACTER A26537 77550020 BAL R9,LRDSCJC SCAN TO NON-BLANK CHARACTER A26537 77600020 CLC 0(4,R1),LRDJO TEST FOR JOB CARD A26537 77650020 LA R14,FOURT SET FOR ENTRY TO BRANCH TBL A26537 77700020 BE BRNTABL BRANCH IF FOUND A26537 77750020 TM TDIRSWCH+1,TDIRJEDN TEST JED SWITCH A26537 77800020 LA R14,EIGHTT SET FOR ENTRY TO BRANCH TBL A26537 77850020 BO BRNTABL BRANCH IF ON A26537 77900020 TM TDIRSWCH+2,TDIRJCLN TEST JCL SWITCH A26537 77950020 LA R14,TWELV SET FOR ENTRY TO BRANCH TABL A26537 78000020 BC 14,BRNTABL IF NOT ON MISSING JOB CARD A26537 78050020 CLC 0(3,R1),LRDD TEST FOR DD CARD A26537 78100020 LA R14,SIXTEEH SET FOR ENTRY TO BRANCH TABL A26537 78150020 BC 7,BRNTABL IF NOT DD CARD A26537 78200020 LA R10,2(R1) GET ADDRESS OF BLANK AFTER DD A26537 78250020 ST R10,LRDSADD STORE AS STARTING ADDRESS FOR A26537 78300020 * SCAN A26537 78350020 BAL R9,LRDSCJC SCAN TO NON-BLANK CHARACTER A26537 78400020 SR R9,R9 CLEAR REGISTER 9 A26537 78450020 STH R9,LCBPARM3+2 PUT 0 IN LCBPARM3 FOR ALC A26537 78500020 CLC 0(2,R1),LRDASTB CHECK FOR BLANK AFTER DD * A26537 78550020 LA R14,TWENT SET FOR ENTRY TO BRANCH TABL A26537 78600020 BE BRNTABL YES IGNORE DCB PARAM ROUNTINE A26537 78650020 CLC 0(5,R1),LRDDAT CHECK FOR BLANK AFTER DD DATA A26537 78700020 LA R14,THIRTY36 SET ENTRY TO BRANCH TABLE A26537 78750020 BE BRNTABL IF THERE IGNORE DCB PARAM ROUTA26537 78800020 CLC 0(2,R1),LRDASTCM CHECK FOR COMMA AFTER DD * A26537 78850020 BE LRDACOMA BRANCH AROUND CHECK FOR DD A26537 78900020 * DATA A26537 78950020 CLC 0(5,R1),LRDATACM CHECK FOR COMMA AFTER DD DATA A26537 79000020 LA R14,SIXTEEH SET FOR ENTRY TO BRANCH TABL A26537 79050020 BNE BRNTABL IF NOT DD DATA OR * BRANCH A26537 79100020 OI TDIRSWCH,TDIRDDDN TURN ON DD DATA SWITCH A26537 79150020 LA R1,5(R1) GET ADDRESS OF BYTE AFTER DATAA26537 79200020 B LRDONECM A26537 79250020 WORK DS D A26537 79300020 LRDPACK PACK WORK(8),0(0,R10) A26537 79350020 LRDACOMA OI TDIRSWCH,TDIRDDAN TURN ON DD * SWITCH A26537 79400020 LA R1,2(R1) GET ADDRESS OF BYTE AFTER DD *A26537 79450020 LRDONECM CLC 0(4,R1),LRDCBPRM CHECK FOR DCB= A26537 79500020 BNE LRDUNDEF IF NOT THERE GO TO ERROR A26537 79550020 * ROUTINE A26537 79600020 LA R1,4(R1) UPDATE COUNTER TO SUBPARAMETERA26537 79650020 CLI 0(R1),C'(' CHECK FOR ( BEFORE A26537 79700020 * SUBPARAMETER A26537 79750020 BNE LRDBUFCK IF NOT THERE BRANCH A26537 79800020 OI LCBPARM3,TIOSDSP2 SET PARENTHESIS SWITCH A26537 79850020 LA R1,1(R1) IF THERE IGNORE IT A26537 79900020 BAL R9,LRDTOCOM CHECK FOR MULTIPLE COMMAS A26537 79950020 LRDBUFCK CLC 0(6,R1),LRDBUFNO CHECK FOR BUFNO PARAMETER A26537 80000020 BNE LRDBLKSI IF NOT THERE BRANCH A26537 80050020 MVI LRDSBLN+1,X'03' SET UP PARAMETER FOR SCAN A26537 80100020 ST R1,LRDSADD STARTING POINT FOR SCAN A26537 80150020 LA R1,20(R1) STOPPING POINT FOR SCAN A26537 80200020 ST R1,LRDSSTO STORE IN PARAMETER LIST A26537 80250020 BAL R9,LRDSCJC SCAN TO BLANK, COMMA OR R A26537 80300020 * PARENTHESIS A26537 80350020 CLI 0(R1),C',' IS IT A COMMA? A26537 80400020 BNE LRDFRMAT IF NOT BLKSIZE WAS NOT A26537 80450020 * SPECIFIED A26537 80500020 LA R1,1(R1) GO TO ADDRESS AFTER COMMA A26537 80550020 BAL R9,LRDTOCOM CHECK FOR MULTIPLE COMMAS A26537 80600020 LRDBLKSI CLC 0(8,R1),LRDBLOCK CHECK FOR BLKSIZE PARAMETER A26537 80650020 BNE LRDUNDEF IF NOT GO TO ERROR ROUTINE A26537 80700020 LA R1,8(R1) GET ADDRESS OF BLKSIZE PARAM A26537 80750020 ST R1,LRDSADD STORE STARTING POINT FOR SCAN A26537 80800020 LR R10,R1 SAVE ADDRESS OF BLKSIZE PARAM A26537 80850020 LA R1,10(R1) SET STOPPING POINT FOR SCAN A26537 80900020 ST R1,LRDSSTO STORE IT IN PARAMETER LIST A26537 80950020 MVI LRDSBLN+1,X'03' NUMBER OF CHARACTERS SCANNED FOR A26537 81000020 BAL R9,LRDSCJC SCAN TO BLANK,COMMA, OR ) A26537 81050020 LR R9,R1 SAVE ADDRESS OF DELIMETER A26537 81100020 SR R1,R10 DETERMINE LENGTH OF PARAMETER A26537 81150020 LTR R1,R1 IS BLKSIZE = BLANK ? A26537 81200020 BZ LRDINVAL IF SO, LET HIM KNOW A26537 81250020 LR R14,R1 GET LENGTH OF PARAM FOR BCT A32862 81300020 LRDHARVD TM 0(R10),X'F0' IS THIS BYTE NUMERIC ? A32862 81350020 BNO LRDINVAL NO? THST'S A BADIE A32862 81400020 LA R10,1(R10) POINT TO THE NEXT BYTE AND A32862 81450020 BCT R14,LRDHARVD CHECK IT THE SAME WAY A32862 81500020 SR R10,R1 RESTORE POINTER TO BLKSIZE A32862 81550020 BCTR R1,0 A27468 81600020 EX R1,LRDPACK PACK THE BLKSIZE WITH THEM A26537 81650020 CVB R1,WORK CONVERT BLKSIZE TO BINARY A26537 81700020 LTR R1,R1 CHECK FOR BLKSIZE OF ZERO A26537 81750020 BC 12,LRDINVAL IF SO GO TO ERROR ROUTINE A26537 81800020 LA R14,400 CHECK TO SEE THAT BLKSIZE IS A26537 81850020 * NOT A26537 81900020 CR R1,R14 GREATER THAN 400 A26537 81950020 BH LRDFORMT IF SO, USE BLKSIZE IN PROC A26537 82000020 SR R14,R14 CLEAR REG 14 FOR DIVIDE A26537 82050020 LR R15,R1 PUT PARAM IN REG 15 FOR DIVIDEA26537 82100020 LA R1,80 CHECK TO SEE THAT THE BLKSIZE A26537 82150020 * IS A26537 82200020 DR R14,R1 A MULTIPLE OF 80 BY DIVIDING A26537 82250020 * AND A26537 82300020 LTR R14,R14 TESTING FOR REMAINDER A26537 82350020 BC 7,LRDINVAL IF NOT GO TO ERROR ROUTINE A26537 82400020 MH R15,EIGHTTY MULTIPLY TO GET PARAMETER BACKA26537 82450020 STH R15,LCBPARM3+2 STORE BLKSIZE FOR ALLOCATION A26537 82500020 LRDFORMT LR R1,R9 CHECK FORMAT OF CARD A26537 82550020 LRDFRMAT CLI 0(R1),C' ' IS IT A BLANK ? A26537 82600020 BE LRDSWHON IF SO, SEE IF PAREN SWITCH IS A26537 82650020 * ON A26537 82700020 CLI 0(R1),C',' IS IT A COMMA ? A26537 82750020 BNE LRDSWHOF IF NOT, SEE IF PAREN SWITCH ONA26537 82800020 BAL R9,LRDTOCOM CHECK FOR MULTIPLE COMMAS A26537 82850020 LRDPARAM CLC 0(6,R1),LRDBUFNO CHECK FOR BUFNO PARAMETER A26537 82900020 BNE LRDUNDEF IF NO, GO TO ERROR ROUTINE A26537 82950020 ST R1,LRDSADD STARTING POINT FOR SCAN A26537 83000020 LA R1,10(R1) GET STOPPING POINT FOR SCAN A26537 83050020 ST R1,LRDSSTO STORE IN PARAMETER LIST A26537 83100020 MVI LRDSBLN+1,X'02' NUMBER OF CHARACTERS SCANNED A26537 83150020 BAL R9,LRDSCJC SCAN FOR BLANK OR RIGHT PAREN A26537 83200020 CLI 0(R1),C' ' IS IT A BLANK ? A26537 83250020 BE LRDSWHON IF SO, SEE IF PAREN SWITCH IS A26537 83300020 * ON A26537 83350020 LRDSWHOF TM LCBPARM3,TIOSDSP2 IS PAREN SWITCH ON ? A26537 83400020 BC 12,LRDUNDEF IF NOT SEND ERROR MESSAGE A26537 83450020 B LRDOFFSW A26537 83500020 LRDSWHON TM LCBPARM3,TIOSDSP2 IS PAREN SWITCH ON ? A26537 83550020 BO LRDUNDEF IF SO, SEND ERROR MESSAGE A26537 83600020 LRDOFFSW NI LCBPARM3,X'00' TURN OFF PAREN SWTCH A26537 83650020 LA R14,TWENT28 SET FOR ENTRY TO BRANCH TABL A26537 83700020 B BRNTABL RETURN TO MAIN ROUNTINE A26537 83750020 LRDTOCOM CLI 0(R1),C',' CHECK FOR MULTIPLE COMMAS A26537 83800020 BCR 7,R9 IF NOT A COMMA BRANCH A26537 83850020 LA R1,1(R1) IF IT IS A COMMA, IGNORE IT A26537 83900020 B LRDTOCOM CHECK FOR MORE MULTIPLE COMMASA26537 83950020 LRDUNDEF LA R0,LRDXM56 GET PARAMTER FOR XMT A26537 84000020 LA R14,THIRTY32 SET FOR ENTRY TO BRANCH TABL A26537 84050020 B BRNTABL TRANSMIT ERROR MESSAGE A26537 84100020 LRDINVAL LA R0,LRDXM60 GET PARAMETER FOR XNT A26537 84150020 LA R14,THIRTY32 SET FOR ENTRY TO BRANCH TABL A26537 84200020 B BRNTABL TRANSMIT ERROR MESSAGE A26537 84250020 LRDSCJC LA R1,LRDSCA GET ADDRESS OF PARAMETER LIST A26537 84300020 L R15,LRDCCSC GET ADDRESS OF SCAN ROUTINE A26537 84350020 BALR R14,R15 CALL SCAN TO FIND CHARACTER A26537 84400020 LTR R15,R15 TEST RETURN CODE A26537 84450020 BCR 7,R9 IF FOUND, RETURN A26537 84500020 TM TDIRSWCH+2,TDIRJCLN IS JCL SWITCH ON A26537 84550020 LA R14,TWELV SET FOR ENTRY TO BRANCH TABL A26537 84600020 BZ BRNTABL NO,STATEMENT INVALID A26537 84650020 LA R14,SIXTEEH SET FOR ENTRY TO BRANCH TABL A26537 84700020 B BRNTABL IF ON IT'S OK A26537 84750020 BRNTABL EQU * A26537 84800020 LR R15,R12 SET NEW BASE A26537 84850020 DROP 12 A26537 84900020 USING LRDNOTCM,R15 A26537 84950020 L R12,LRDBASE SET BASE FOR MAIN ROUTINE A26537 85000020 B *+4(14) BRANCH INTO BRANCH TABLE A26537 85050020 DROP 15 A26537 85100020 USING IHKABLRD+2,R12 A26537 85150020 B LRDJOBCD A26537 85200020 B LRDJEDSW A26537 85250020 B LRDNOJOB A26537 85300020 B LRDJCLBF A26537 85350020 B LRDDDAST A26537 85400020 B LRDDDCRD A26537 85450020 B LRDCLXMT A26537 85500020 B LRDDDATA A25637 85550020 LRDCCSC DC V(IHKCCSCN) ENTRY OF SCAN ROUTINE A26537 85600020 LRDSCA DC H'0' A26537 85650020 LRDSBLN DC H'0' A26537 85700020 LRDSADD DC F'0' STARTING ADDRESS OF SCAN A26537 85750020 LRDSSTO DC F'0' STOPPING ADDRESS OF SCAN A26537 85800020 LRDCHA DC C' ' A26537 85850020 DC C'),' ON RIGHT PAREN OR COMMA A26537 85900020 LRDJO DC C'JOB ' A26537 85950020 LRDD DC C'DD ' TEST FOR DD CARD A26537 86000020 LRDASTB DC C'* ' TEST FOR * BLANK A26537 86050020 LRDDAT DC C'DATA ' TEST FOR DD DATA CARD A26537 86100020 LRDASTCM DC C'*,' A26537 86150020 LRDATACM DC C'DATA,' A26537 86200020 LRDCBPRM DC C'DCB=' A26537 86250020 LRDBUFNO DC C'BUFNO=' A26537 86300020 LRDBLOCK DC C'BLKSIZE=' A26537 86350020 EIGHTTY DC H'0080' A26537 86400020 LRDXM56 EQU 56 CODE FOR IMPROPER DD CARD A26537 86450020 LRDXM60 EQU 60 CODE FOR IMPROPER DD CARD A26537 86500020 LRDSVBL DC A(LRDSVBLK) A26537 86550020 LRDBASE DC A(IHKABLRD+2) BASE FOR MAIN ROUTINE A26537 86600020 FOURT EQU 0 INDEX INTO BRANCH TABLE A26537 86650020 EIGHTT EQU 4 INDEX INTO BRANCH TABLE A26537 86700020 TWELV EQU 8 INDEX INTO BRANCH TABLE A26537 86750020 SIXTEEH EQU 12 INDEX INTO BRANCH TABLE A26537 86800020 TWENT EQU 16 INDEX INTO BRANCH TABLE A26537 86850020 TWENT28 EQU 20 INDEX INTO BRANCH TABLE A26537 86900020 THIRTY32 EQU 24 INDEX INTO BRANCH TABLE A26537 86950020 THIRTY36 EQU 28 INDEX TO BRANCH TABLE A26537 87000020 LRDFSTB EQU X'01' SCAN FOR FIRST BLANK CHARACTER A26537 87050020 EJECT 96060000 IEFQMNGR QUEUE MANAGER PARAMETER AREA 96120000 QMPCA DS CL4 BUFFER ADDRESS OR TTR FROM ASSIGN 96180000 QMPEX DS CL4 TTR FOR WRITE 96240000 QMCHN DS CL4 TTR FOR NEXT WRITE 96300000 EJECT 96360000 LRDQMRES DSECT 96420000 IEFQMRES QUEUE MANAGER RESIDENT AREA 96480000 EJECT 96540000 IECTDECB 96600000 EJECT 96660000 DCBD DSORG=(BS,BX),DEVD=(DA,BS) 000E 96720000 EJECT 96780000 LRDTIOT1 DSECT 96840000 IEFTIOT1 96900000 EJECT 96960000 LRDCVT DSECT 97020000 CVT 97080000 IHKDSECT TDIR 97140000 TDIRNQJM EQU X'CF' TURN OFF ENQUEUE JOBS AND ENQUEUE 97200000 * MESSAGES BITS 97260000 TDIRSYSF EQU X'3F' TURN OFF DD DATA AND DD * SWITCHES 97320000 TDIRSYSN EQU X'C0' TEST DD DATA AND DD * SWITCHES 97380000 TDIRRJLF EQU X'E7' TURN OFF RJSTART AND LOGON SWITCHES 97440000 TDIRRJLG EQU X'18' TEST RJSTART AND LOGON SWITCHES 97500000 TDIRDARF EQU X'3E' TURN OFF DD DATA, DD *, NO RJENDF 97560000 TDIRJDIP EQU X'FA' TURN OFF JED AND DISCONTINUED INPUT 97620000 IHKDSECT ,,FASTAB 97680000 IHKDSECT ,,,,,AVT 97740000 IHKDSECT ,,,,LCB 97800000 LCBSWOFF EQU X'00' TO TURN OFF LCB SWITCHES 97860000 LCBNQBIT EQU X'80' INDICATE CARDS TO ENQUEUE 000A 97920000 LCBNQOFF EQU X'7F' INDICATE NO CARDS TO ENQUEUE 000A 97980000 LCBERRSW EQU X'40' INDICATE RETURN 8 TO IHKABLST 98040000 LCBSTRJE EQU X'20' INDICATE RETURN OF ZERO TO LST 98100000 LCBRJNDF EQU X'10' INDICATE RJENDF GENERATED 000A 98160000 LCBLST28 EQU X'08' INDICATE RETURN 28 TO IHKABLST 000A 98220000 END 98280000 ./ ADD SSI=05010810,NAME=IHKABLST,SOURCE=0 LST8 TITLE 'IHKABLST -- LINE SCHEDULER' 00100019 IHKABLSD CSECT 00200019 *1210515000-518000,642000 000B 00300019 *2561697000 1657 00400019 * 258000,261000,359600,485000,487000,492000,495000,506000,511000 000D 00500019 * 512000,518000-519000,540000,5590,003000-009000 000D 00600019 * 744000,747000 A29519 00630020 * A28208 00660020 *D253500 A35889 00666020 *A252500 A35889 00672020 *C807000,808000 A37785 00678020 *D501000 A37794 00684020 *C281000,539000,583000 A37794 00690020 *A126500,148400,149200-149600,151100-151500,160300-160600 A43087 00692021 *A774100-774900,847100-847500 A43087 00694021 *C148800 A43087 00696021 *D638000,708000 A47940 00696621 *A248100-248700,608020-608840,638000-638500 A47940 00697221 *C220000,222000,319000,352000,640000 A47940 00697821 *A792200-792600 A53111 00698421 *C702000,714000,790000,798000 A53111 00699021 *D769000 A60657 00700021 *A769000-769600 A60657 00740021 * * 00780021 ENTRY IHKABLST 00820021 EXTRN IHKCACOM 00860021 *********************************************************************** 00900019 *TITLE LINE SCHEDULER 'IHKABLST' * 01000019 * * 01100021 *STATUS: CHANGE LEVEL 2, RELEASE 21.7 * 01150021 * * 01200019 *FUNCTION/OPERATION: THE BASIC FUNCTIONS OF THE LINE SCHEDULER ARE: * 01300019 * 1. CHECKS FOR QUEUED OUTPUT ON THE TERMINAL QUEUE. * 01400019 * 2. DOES A READ/INITIAL TO ESTABLISH CONTACT WITH THE REMOTE. * 01500019 * A TESTS AFTER ATTEMPTED I/O TO DETERMINE THAT THE CONTROL UNIT IS* 01600019 * STILL OPERATIONAL.IF NOT SENDS THAT LINE SUB TASK TO THE DISPATCH* 01700019 * TO WAIT FOR A CLOSE DOWN * 01800019 * 3. HALTS ACTIVITY ON EACH LINE TO INITIATE THE STOP RJE * 01900019 * 4. RJENDS EACH ACTIVE TERMINAL AFTER A WARMSTART * 02000019 * 5. OPENS THE DCBS FOR THE LINES * 02100019 * A TESTS THE OPEN FLAGS FOR THE LINE DCB AND IF THE DCB DID NOT * 02200019 * OPEN, IT PRINTS A MESSAGE INDICATING IT COULD NOT AND SEND THAT * 02300019 * SUB TASK TO THE DISPATCHER TO AWAIT A RJE CLOSEDOWN. * 02400019 * 6. FLAGS EACH LINE CONTROL BLOCK TO INDICATE WHAT TYPE OF LINE THE* 02500019 * LCB IS ASSOCIATED * 02600019 * * 02700019 *ENTRY POINT * 02800019 * IHKABLSD * 02900019 * THIS ENTRY POINT DOES THE OPENS FOR THE LINE AND FLAGS THE LCB AS * 03000019 * TO THE TYPE OF LINE * 03100019 * IHKABLST * 03200019 * THIS ENTRY POINT IS A BRANCH TABLE. THE SPECIFIC ENTRY INTO THE * 03300019 * BRANCH TABLE IS DETERMINED BY THE RETURN CODE IN REGISTER 15. THE * 03400019 * FOLLOWING CODES DETERMINE THE FUNCTION NEEDED BY THE RETURNING * 03500019 * SUB-ROUTINE. * 03600019 * * 03700019 * O-NORMAL RETURN. LINE SCHEDULER WILL DO ITS NORMAL FUNCTIONS * 03800019 * 4-GO TO IHKABREQ. LINE ANALYSIS WRITE RETURNS TO THIS POINT * 03900019 * BECAUSE THE LINE SCHEDULER CALLED IT TO SEND OUTPUT AND IT WAS * 04000019 * UNABLE TO DO SO. * 04100019 * 8-GO TO IHKABEOT THIS SUB-ROUTINE SWAPS EOTS WITH THE REMOTE TERM-* 04200019 * INAL ON A SWITCHED LINE. UNTIL AN ENQ IS RECEIVED INDICATING THE* 04300019 * REMOTE WISHES TO SEND INPUT, OR UNTIL THERE IS OUTPUT TO SEND * 04400019 * THE REMOTE. * 04500019 * 12-EXITS TO LINE ANALYSIS WRITE ROUTINE BECAUSE LINE ANALYSIS READ* 04600019 * HAS RUN OUT OF SPACE TO SPOOL THE INPUT. * 04700019 * 16-EXIT TO RJENDF ROUTINE. THIS IS A RETURN EXIT THROUGH THE LINE * 04800019 * SCHEDULER FROM THE LINE ANALYSIS WRITE ROUTINE TO THE LINE * 04900019 * ANALYSIS READ TO BUILD AN RJENDF. * 05000019 * 20-EXITS TO THE DISPATCHER TO WAIT FOR THE LINE ANALYSIS READ TO * 05100019 * 24-RETURN CODE INDICATES A NORMAL RETURN FROM LINE ANALYSIS READ * 05200019 * ON A SWITCHED LINE. * 05300019 * GET QUEUE SPACE. THIS SITUATION ARISES WHEN THE LINE SCHEDULER * 05400019 *INPUT:400 CHARACTER RECORDS FIVE 80-CHARACTER CARD IMAGES * 05500019 * REQUESTS LINE ANALYSIS READ TO ENQUEUE A RJENDF OR RJENDC. * 05600019 * * 05700019 *OUTPUT: THE OUTPUT IS THE INPUT RECEIVED BY THE READ/INITIAL * 05800019 * * 05900019 *EXTERNAL ROUTINES * 06000019 * IHKAADSP- DISPATCHER CONTAINS MULTIPLE WAIT * 06100019 * IHKABLRD- LINE ANALYSIS(READ). STRIPS DATA LINK CONTROL * 06200019 * CHARACTERS AND WRITES INPUT TO DISK. * 06300019 * IHKABLWR- LINE ANALYSIS(WRITE). WRITE OUTPUT TO REMOTE WORK * 06400019 * STATIONS. * 06500019 * * 06600019 *EXITS-NORMAL * 06700019 * REGISTER 15 CONTAINS ADDRESS POINTER TO: * 06800019 * IHKAADSP * 06900019 * IHKABLRD * 07000019 * IHKABLWR * 07100019 * * 07200019 *EXITS-ERROR: * 07300019 * IHKABRJF-ENTRY POINT IN IHKABLRD TO BUILD RJENDF. * 07400019 * IHKAADSP-ERROR ON OPEN OR BAD CONTROL UNIT * 07500019 * * 07600019 *TABLES/WORK AREAS: * 07700019 * LINE CONTROL BLOCK- CONTROL BLOCK WHICH CONTAINS POINTERS TO OTHER* 07800019 * CONTROL BLOCKS AND BUFFERS. * 07900019 * * 08000019 *ATTRIBUTES:RE-ENTRANT * 08100019 *NOTES - THE OPERATION OF THIS SUBROUTINE DEPENDS UPON AN INTERNAL * 08200019 * REPRESENTATION OF THE EXTERNAL CHARACTER SET WHICH IS EQUIVALENT * 08300019 * TO THE ONE USED AT ASSEMBLY TIME. THE CODING HAS BEEN ARRANGED SO* 08400019 * THAT REDEFINITION OF CHARACTER-TYPE CONSTANTS, BY REASSEMBLY, WILL* 08500019 * RESULT IN A CORRECT MODULE FOR THE NEW DEFITION. * 08600019 *********************************************************************** 08700019 R0 EQU 0 08800019 R1 EQU 1 08900019 R2 EQU 2 09000019 R3 EQU 3 09100019 R4 EQU 4 09200019 R5 EQU 5 09300019 R6 EQU 6 09400019 R7 EQU 7 09500019 R8 EQU 8 09600019 R9 EQU 9 09700019 R10 EQU 10 09800019 R11 EQU 11 09900019 R12 EQU 12 10000019 R13 EQU 13 10100019 R14 EQU 14 10200019 R15 EQU 15 10300019 LSTOPN EQU X'12' OPENS FLAG SETTINGS FOR SUCCESSFUL OPEN 10400019 LSTSTPB EQU X'80' STOP RJE BIT SET BY IHKCASTP 10500019 LSTWRMB EQU X'40' WARMSTART BIT SET BY IHKCBSDQ 10600019 LSTWJDAB EQU X'20' WAIT ON SYSDEQ BIT SET BY INKCBSDQ 10700019 LSTDCNTC EQU X'02' DISCONTINUE SWITCH SET BY CONTENTION ON LINE 10800019 LSTDCNT EQU X'80' DISCONTINUE SWITCH SET BY DISCONTINUE ABORT 10900019 LSTCONTT EQU X'60' CONTINUE SWITCH INDICATORS SET BY A CONTINUE 11000019 LSTEOT EQU X'37' FOR EOT IN DECB RESPONSE FIELD 11100019 LSTENQ EQU X'2D' FOR ENQ IN DECB RESPONSE FIELD 11200019 DEBUCBAD EQU 32 DISPLACEMENT VALUE IN DEB FOR UCB ADDRESS 11300019 UCBTBYT2 EQU 17 DISPLACEMENT VALUE IN UCB FOR DEVICE TYPE 11400019 LSTDISAB EQU X'02' SWITCH INDICATING A DISABLED SWITCHED LINE 11500019 LSTRJSTR EQU X'10' TEST IF RJSTART SWITCH IS SET ********** 11600019 LSTTEN EQU X'10' 11700019 LSTTWO EQU 2 THIS VALUE IS THE LENGTH OF THE POLLING CHA- 11800019 LSTTYMDL EQU X'40' UCB INDICATES A MULTI-DROP LINE 11900019 LSTTYSW EQU X'10' UCB INDICATES A SWITCHED LINE 12000019 * ACTERS IN THE TERMINAL TABLE 12100019 UCBNAME EQU 13 OFFSET IN UCB TO UCBNAME 12200019 LSTTHREE EQU X'03' NUMBER OF CHARS MOVED INTO MGS1 12300019 LSTMSIN2 EQU 18 12400019 LSTMSIN1 EQU 35 12500019 LSTEIGHT EQU X'08' NUMBER OF CHARS MOVED INTO MSG1 12600019 LSTWTMOD EQU X'20' WORLD TRADE MODEM SWITCH A43087 12650021 *********************************************************************** 12700019 * THIS ROUTINE SETS AN INDICATOR IN THE LCB TO INDICATE THE TYPE OF * 12800019 * TERMINALS THAT ARE HOOKED TO THIS PARTICULAR LINE. THIS ROUTINE * 12900019 * ONCE FOR EACH LINE * 13000019 *********************************************************************** 13100019 USING *,R14 13200019 USING LCBDSECT,R2 13300019 USING IECTDECB,R3 13400019 USING IHADCB,R4 13500019 USING IHKZZAVT,R5 13600019 B Z 13700019 DC C'IHKABLST' 13800019 Z EQU * 13900019 L R3,LCBLDECB USING LCB POINTER IN REG2 THE DECB 14000019 L R4,DECDCBAD POINTER IS LOADED FROM THE LCB. FROM 14100019 OPEN ((4)) THE DECB AN ADDRESS OF THE DCB. 14200019 L R12,LSTABLST SETS BASE 14300019 TM DCBOFLGS,LSTOPN TEST OPEN FLAGS 14400019 BNO LSTDDMSS NO GO TO WRITE MSG 14500019 L R5,DCBDEBAD THE DCB AN ADDRESS OF THE DEB. FROM 14600019 L R6,DEBUCBAD(R5) THE DEB AN ADDRESS TO THE UCB. 14700019 TM UCBTBYT2(R6),LSTTYMDL THE UCB RJE DETERMINES THE TYPE OF 14800019 * LINE LCB IS USED FOR A43087 14840021 BO LSTVERMP VERIFY THAT LINE WAS A43087 14880021 * DEFINED AS MULTI-PT IN A43087 14920021 * RJELINE MACRO A43087 14960021 TM UCBTBYT2(R6),LSTTYSW LCB IS FLAG WITH A 15000019 BO LSTSW FF= A SWITCHED LINE 15100019 TM LCBLDECB,LSTWTMOD VERIFY THAT PT/PT LINE A43087 15110021 BO LSTERR HAS NOT BEEN DEFINED AS A43087 15120021 L R8,LCBDFTRM SWITCHED LINE VIA A43087 15130021 CLI LSTZEROO(R8),LSTANST RJELINE MACRO A43087 15140021 BE LSTERR A43087 15150021 MVI LCBTYPLN,LCBPTPT FE= A POINT TO POINT 15200019 B LSTSEBAS FD= A MULTI POINT 15300019 * 15400019 * ONCE INITIALIZED AT START UP TIME 15500019 * PART OF THE LINE SCHEDULER IS NEVER 15600019 * RE-ENTERED. 15700019 * 15800019 LSTSW MVI LCBTYPLN,LCBSWTCH INDICATE SWITCHED LINE 15900019 B LSTSEBAS 16000019 LSTVERMP CLI LCBTABNM,LSTDZERO IF MP LINE THIS LCB A43087 16030021 BE LSTERR FIELD SHOULD NOT BE ZERO A43087 16060021 LSTMP MVI LCBTYPLN,LCBMULPT INDICATE MULTI-POINT LINE 16100019 LSTSEBAS XR R15,R15 SETS RETURN CODE FOR ENTRY 000A 16200019 *********************************************************************** 16300019 * THE FOLLOWING IS A BRANCH TABLE THAT DETERMINES WHAT FUNCTION * 16400019 * HAS BEEN COMPLETED THIS IN TURN TELLS THE LINE SCHEDULER WHICH * 16500019 * FUNCTION MUST FOLLOW * 16600019 * THE RETURN CODE IN REGISTER 15 ARE * 16700019 * 0 GO TO LSTBEGIN * 16800019 * 4 GO TO IHKABREQ * 16900019 * 8 GO TO IHKABEOT * 17000019 * 12 EXIT TO IHKABLWR * 17100019 * 16 EXIT TO RJENDF ROUTINE * 17200019 * 20 EXIT TO OUT OF SPACE RJEND * 17300019 * 24 NORMAL RETURN ON SWITCHED FROM IHKABLRD * 17400019 * 28 ENTRY TO SEND ABORT EOT * 17500019 *********************************************************************** 17600019 IHKABLST EQU * 17700019 USING TDIREC,R4 17800019 BALR R12,0 17900019 USING *,R12 18000019 L R3,LCBLDECB SETS BASE FOR LINE DECB DSECT 000A 18100019 L R4,LCBTDIR SETS BASE FOR TDIREC DSECT 000A 18200019 B *+4(15) 18300019 B LSTBEGIN NORMAL RETURN 18400019 B IHKABREQ GO DO A READ CONTINUE 18500019 B IHKABEOT GO DO A WRITE EOT 18600019 B LSTBYPAS EXIT TO IHKABLWR 18700019 B LSTRJLRD EXIT TO RJENDF ROUTINE 18800019 B LSTOUTSP EXIT TO OUT OF SPACE 18900019 B LSTABOUT EXIT TO CHECK OUTPUT ROUTINE 19000019 B LSTABORT EXIT TO ABORT ROUTINE 000A 19100019 B LSTOPEN 000D 19200019 *********************************************************************** 19300019 * THIS ROUTINE CHECKS WHAT TYPE OF LINE ITS SERVICING. IF THERE* 19400019 * IS ANY OUTPUT TO BE SENT. SHOULD THIS LINE BE CLOSED DOWN IF THE * 19500019 * LINE IS SWITCHED HAS IT BEEN DISABLED * 19600019 *********************************************************************** 19700019 LSTBEGIN L R3,LCBLDECB SETS BASE FOR LINE DECB DSECT 19800019 L R4,LCBTDIR SETS BASE FOR TDIREC DSECT 19900019 BAL R9,LSTWMSTP 20000019 LTR R4,R4 CHECKS LCB TO SEE IF THEIR IS A USER 20100019 BC 8,LSTRDTI ON THIS LINE 20200019 TM TDIRSWCH+1,LSTDISAB CHECKS FOR A DISCONNECTED TERMINAL 20300019 BZ LSTBYPAS IF NOT CONTINUE 20400019 NI TDIRSWCH+1,TDIRDABF RESETS DISABLE SWITCH 20500019 XC LCBTDIR,LCBTDIR IF SO ZERO LCB POINTER TO TDE AND 20600019 XC TDIRLCB,TDIRLCB ZERO LCB PTR IN TDE A28208 20630020 NI TDIRSWCH,TDIRRJSF TURN OFF RJSTART SWCH A28208 20660020 B LSTRDTI DO A READ INITIAL 20700019 LSTBYPAS CLI LCBTYPLN,LCBMULPT CHECKS TO SEE IF THIS IS A MULTI- 20800019 BE LSTLSTCK POINT LINE 20900019 LA R10,LSTRDENQ SET RETURN FROM OUTPUT CHECK ROUTINE 21000019 B LSTWRCHK GO TO CHECK FOR OUTPUT ROUTINE 21100019 *********************************************************************** 21200019 * THIS ROUTINE IS ENTERED TO DO A READ OPERATION BECAUSE OUTPUT CANT * 21300019 * BE SENT OR THERE ISNT ANY TO BE SENT * 21400019 *********************************************************************** 21500019 IHKABREQ EQU * 21600019 LSTDISCT BAL R9,LSTWMSTP CHECK FOR STP OR WRMSTART 21700019 LSTRDENQ CLI LCBTYPLN,LCBSWTCH CHECKS TO SEE IF THIS IS A SWITCHED 21800019 BNE LSTCDCHK LINE - BRANCH IF NOT 000A 21900019 BAL R14,LSTCLRBF THIS IS A READ CONTINUE TO CONTINUE A47940 22000021 READ (1),TT,,'S','S',MF=E ON A SWITCHED OR LEASED LINE 22100019 LSTRETST LA R9,LSTBDRD SET ERROR RETUN EXIT A47940 22200021 LA R10,LSTLRDEX SETS NORMAL EXIT 000A 22300019 *********************************************************************** 22400019 * THIS ROUTINE CHECKS FOR SUCCESSFUL START I/O IF GOOD PASSES * 22500019 * CONTROL TO THE DISPATCHER TO WAIT FOR THE I/O TO FINISH. IT THEN * 22600019 * CHECK FOR A GOOD COMPLETION CODE. IF THE COMPLETION CODE IS A X'7F'* 22700019 * IT PASSE CONTROL TO THE LINE ANALYSIS READ ROUTINE. IF THE * 22800019 * COMPLETION CODE IS X'48' IT GOES TO IHKABLST. IF IT IS X'41' IT * 22900019 * RJENDFS THE TERMINAL. THIS SUBROUTINE IS USED BY BOTH BTAM READS * 23000019 * IN THIS ROUTINE. * 23100019 *********************************************************************** 23200019 LSTRDTST C R15,LSTERROR CHECKS FOR OPERATIONAL CONTROL UNIT 23300019 BE LSTQUIT EXIT TO MSG WRITTER 23400019 LTR R15,R15 TESTS FOR A GOOD SIO OF NOT RELEASE 23500019 LA R8,LSTBEGIN SETS RENTRY POINT FOR RELEASE BUFFER 23600019 BC 7,LSTRBUFF THE BUFFER 23700019 L R15,LSTAADSP GOES TO DISPATCHER WITH ECB POINTER 23800019 BALR 14,15 IN REG 1 23900019 NI DECTYPE,LSTTOOFF RESET FOR BTAM ERROR MESSAGE 000A 24000019 * FOR TIME OUT 000A 24100019 L R14,LSTREIGH(R1) LOAD DCB POINTER 000D 24200019 NI LSTRFIVE(R14),LSTHIBTF SET FLAG FOR IMED INTERP OFF000D 24300019 TM DECFLAGS,LSTHIOP TESTS FOR NEG RETURN ON POLL 000A 24400019 BO LSTRBUFF ON I/O HALTED RELEASE BUFFER 000A 24500019 CLI 0(R1),LSTGIO CHECK FOR GOOD I/O 24600019 BCR 8,R10 BRANCH TO NORMAL EXIT 000A 24700019 BR R9 BRANCH TO ERROR EXIT 000A 24800019 SPACE 24810021 LSTBDRD L R15,DECAREA A47940 24820021 CLC 0(3,R15),STKUN WAS STACKER UNLOAD BUTTON PRESSED A47940 24830021 BE REREAD YES - BRANCH A47940 24840021 CLC 0(3,R15),CDJAM WAS THERE A CARD JAM A47940 24850021 BE REREAD YES - BRANCH A47940 24860021 SPACE 24870021 LSTRESPL CLI 0(R1),LSTHIO CHECKS FOR A RESET POLL 24900019 BE LSTRBUFF GOES TO RELEASE BUFFER ROUTINE 25000019 CLI LCBTYPLN,LCBMULPT CHECK FOR MULTIPOINT LINE 000A 25100019 BNE LSTSKIP2 BRANCH IF NOT MULTIPOINT 000A 25200019 BAL R8,LSTRBUFF GO DO RELEASE BUFF A35889 25250020 BAL R15,LSTCKBD IF MULTIPOINT, GO TO SUBROUT 000A 25300019 * TO PUT TDIR ADDR IN LCBTDIR, 000A 25400019 * SET R7 TO TERM TABLE ENTRY 000A 25500019 LSTHERE EQU * 000A 25600019 TM LSTZEROO(R7),LSTHIBIT HAS THIS ERROR OCCURED BEFORE 000D 25700019 BO LSTLSTCK YES, GO READ TI FOR NEXT 000A 25800019 * TERM IN POLLING LIST 000A 25900019 OI LSTZEROO(R7),LSTHIBIT SET ERROR FLAG 000D 26000019 L R4,LCBTDIR GET TERMINAL DIRECTORY ENTRY 000A 26100019 MVC LSTTRMBD,TDIRTERM INSERT TERMID INTO MSG 000A 26200019 LA R1,LSTBADMS PASS MSG TO WTO 000A 26300019 SVC 35 SEND TERM NOT RESPONDING MSG 000A 26400019 B LSTRJEDF DOES THIS TERM NEED RJENDING 000A 26500019 LSTSKIP2 EQU * 000A 26600019 L R4,LCBTDIR IS THIS ERROR ON A READ INIT 000A 26700019 LTR R4,R4 OPERATION. IF SO, THE LINE IS 000A 26800019 BC 8,LSTHNGUP NOT RJENDF 26900019 LA R8,LSTRJEDF ANY OTHER COMPLETION CODE IS 27000019 B LSTRBUFF CONSIDERED AS AN ERROR 27100019 *******************************************************************000A 27200019 * THIS ROUTINE CHECKS FOR CONTENTION DISCONTINUE ON MULTI-POINT 000A 27300019 * LINE 000A 27400019 *******************************************************************000A 27500019 LSTCDCHK EQU * 000A 27600019 CLI LCBTYPLN,LCBMULPT CHECK FOR MULTI-POINT LINE 000A 27700019 BNE LSTRDTI BRANCH IF NOT MULTI-POINT 000A 27800019 TM TDIRSWCH+2,TDIRCDSN CHECK FOR CONTENTION DISCONTINUE000A 27900019 BZ LSTLSTCK BRANCH IF NOT 000A 28000019 BAL R5,NOTEST GET NUMBER OF POLLING CHARS. A37794 28100020 L R7,LCBCTMTB LOAD TERM TABLE POINTER 000D 28200019 L R5,LSTZEROO(R7) GET CURRENT TERM TABLE POINTER 000A 28300019 CHKSYN EQU * M2642 28310019 CLI LSTZEROO(R5),LSTSYNC CHECK FOR SYNC CHARACTER M2642 28320019 BNE ALRIGHT NO SYN LET POINTER BE M2642 28330019 LA R5,LSTONE(R5) STEP POINTER FORWARD M2642 28340019 BCTR R10,0 DECREASE POINTER BY ONE M2642 28350019 B CHKSYN CHECK AGAIN M2642 28360019 ALRIGHT EQU * M2642 28370019 EX R10,LSTMVPOL MOVE POLLING CHARACTER(S) FROM 000A 28400019 * TERM TABLE TO DFTRMLST IN TDIR 000A 28500019 LA R8,TDIRDFTA+3 GET ADDRESS OF DFTRMLST FOR 000C 28600019 * POLLING JUST THIS TERMINAL 000A 28700019 B LSTRDTIA READ TO CLEAR LINE 000A 28800019 *********************************************************************** 28900019 * THIS IS A COMMON ROUTINE THAT DETERMINES IF THERE IS OUTPUT AND IF * 29000019 * THERE IS CAN IT BE SENT * 29100019 *********************************************************************** 29200019 LSTWRCHK L R4,LCBTDIR LOADS TDE POINTER 29300019 LTR R4,R4 CHECKS IF POINTER EXIST 29400019 BC 7,LSTWRCHI IF SO CHECK FOR OUTPUT 29500019 CLI LCBTYPLN,LCBSWTCH CHECK FOR SWCH LINE 29600019 BE IHKABEOT YES GO SEND EOT 29700019 B LSTRDTI NO GO DO READ INITIAL 29800019 LSTWRCHI TM TDIRSTAT,TDIRDQNN TEST IF DEQUEUE NOTHING IS SET 000A 29900019 BO LSTRETUR IF SO RETURN 000A 30000019 TM TDIRSWCH+1,LSTDCNT CHECK IF THIS TERMINAL HAS DISCON- 30100019 BO LSTCONTU TINUED OUTPUT IF SO CHECK CONTINUE 30200019 TM TDIRSWCH+2,LSTDCNTC CHECK FOR CONTENTION DISCONTINUE 30300019 BO LSTLWREX IF SO OK TO GO TO IHKABLWR 30400019 CLC TDIRFQEB+1(3),LSTZEROQ CHECKS ANY OUTPUT ENQUED FOR 30500019 BNE LSTLWREX THIS TERMINAL IF SO GO TO IHKABLWR 30600019 LSTRETUR BR R10 RETURN TO CALLING SUB ROUTINE 30700019 LSTCONTU TM TDIRSWCH+1,LSTCONTT CHECK IF TERMINAL HAS CONTINUED 30800019 BZ LSTRETUR NO= RETURN TO CALLING SUB ROUTINE 30900019 B LSTLWREX YES= GO TO IHKABLWR 31000019 *********************************************************************** 31100019 * THIS ROUTINE DOES A READ INITIAL OPERATION * 31200019 *********************************************************************** 31300019 LSTRDTI BAL R9,LSTWMSTP CHECKS TO SEE IF THE RJEND PROCEDURE 31400019 * SHOULD BE ENTERED 31500019 CLI LCBTYPLN,LCBMULPT CHECK FOR MULTI-POINT LINE 000A 31600019 BE LSTLSTCK YES CHECK FOR O/P FIRST 000A 31700019 LSTRDTIT L R8,LCBDFTRM LOADS DEFINE TERMINAL LIST POINTER 31800019 LSTRDTIA BAL R14,LSTCLRBF INITIALIZE FOR READ A47940 31900021 *******************************************************************000D 32000019 * THIS ROUTINE CHECKS FOR A SWITCHED WORLD TRADE MODEM *000D 32100019 *******************************************************************000D 32200019 TM LCBFLG,LCBSWRLD TEST FOR WORLD TRADE MODEM 000D 32300019 BC 8,LSTRDTID NO SKIP WORLD TRADE PROCESSING 000D 32400019 CLI LCBTYPLN,LCBSWTCH CHECK FOR SWITCH LINE 000D 32500019 BNE LSTRDTID NO GO DO READ INITIAL 000D 32600019 L R6,LSTEIGHT(R1) LOADS DCB ADDRESS 000D 32700019 USING IHADCB,R6 000D 32800019 L R11,DCBBUFCB GET BUFFER CONTROL BLOCK ADDRESS000D 32900019 DROP R6 000D 33000019 L R7,LSTDZERO(R11) GETS BUFFER ADDRESS 000D 33100019 LA R7,LSTFOUR(R7) STEPS PTR PAST CHAIN PTR IN BUFF 000D 33200019 MVI LSTDZERO(R7),LSTMKCH MOVES TONE CHAR IN AREA 000D 33300019 MVC LSTONE(LSTMARK,R7),LSTDZERO(R7) PROPAGATES TONE 000D 33400019 MVC LSTMAR(LSTMRK,R7),LSTMARK(R7) INTO BUFFER AREA 000D 33500019 IC R9,LSTEIGHT(R8) SAVES FIRST BYTE OF AREA 000D 33600019 ST R7,LSTEIGHT(R8) STORE POINTER IN DFTRMLST 000D 33700019 STC R9,LSTEIGHT(R8) RESTORES FIRST OF AREA 000D 33800019 LSTRDTID EQU * 000D 33900019 TM LCBLDECB,LCBZTDRN TEST ZERO LCBTDIR FLAG 000B 34000020 BZ LSTSKZER NOT ON SKIP ZEROING 000B 34100019 XC LCBTDIR,LCBTDIR ZEROES TDIR PTR IN LCB 000B 34200019 LTR R4,R4 TEST FOR TDIR PTR A28208 34210020 BZ NOTDIR NO PTRC SKIP ZERO FUNCTION A28208 34220020 XC TDIRLCB,TDIRLCB ZERO TDIR LCB AND TURN A28208 34230020 NI TDIRSWCH,TDIRRJSF TURN OFF RJSTART SWITCH A28208 34240020 NOTDIR EQU * A28208 34250020 NI LCBLDECB,LCBZTDRF RESETS ZERO LCBTDIR FLAG 000B 34320020 LSTSKZER EQU * 000B 34400019 CLI LSTZEROO(R8),LSTANST CHECK FOR LIST WITH ID VERIF 000D 34500019 BE LSTRDTC YES DO TC TYPE OF READ INITIAL 000D 34600019 READ (1),TI,,'S','S',(8),MF=E DOES READ INITIAL FOR INPUT 34700019 LSTLSTLS EQU * 000D 34800019 CLI LCBTYPLN,LCBMULPT CHECKS FOR MULTI-DROP 000A 34900019 BNE LSTDONT 000A 35000019 OI DECTYPE,LSTTOFLG INDICATE NO BTAM ERROR MSG 000A 35100019 LSTDONT LA R9,LSTBDRD A47940 35200021 LA R10,LSTLRDEX SETS NORMAL EXIT 000A 35300019 B LSTRDTST FROM SOME TERMINAL ON THISLINE 35400019 LSTRDTC EQU * 000D 35500019 READ (R1),TC,,'S','S',(R8),MF=E 000D 35600019 B LSTLSTLS GO CHECK I/O OPERATION 000D 35700019 ********************************************************************** 35800019 * THIS ROUTINE INDEXES THE POLLING POINTER TO THE NEXT ENTRY * 35900019 * AND CHECKS FOR END OF LIST. IF END OF LIST IS FOUND * 36000019 * THE BEGINNING OF LIST ADDRESS IS USED * 36100019 ********************************************************************** 36200019 LSTLSTCK L R3,LCBLDECB SET BASE FOR DSECT 000A 36300019 CLI DECPOLPT,LSTDZERO CHECKS FOR FRIST TIME POLL 000A 36400019 BE LSTRDTIT YES GO LOAD BEGINNING OF LIST 000A 36500019 BAL R10,LSTNSWCH GO CHECK FOR OUTPUT 000A 36600019 LSTDFIND L R9,LCBDFTRM LOADS POLLING ADDRESS LIST 000A 36700019 XC LCBTDIR,LCBTDIR CLEAR TERMINAL DIR ENTRY POINTER000A 36800019 BCTR R9,R0 DEC COUNT 000A 36900019 SR R10,R10 000A 37000019 IC R10,LSTZEROO(R9) GETS ENTRY WIDTH 000A 37100019 SRL R10,LSTFIVE SHIFTS OFF UNWANTED BITS 000A 37200019 LSTPOLPT AR R9,R10 MOVES POINTER TO INDEX BYTE 000A 37300019 CLI LSTONE(R9),LCBPTPT CHECKS FOR END OF LIST 000A 37400019 BE LSTRDTIT YES LOAD FIRST OF LIST 000A 37500019 CLC DECPOLPT(LSTONE),LSTZEROO(R9) CHECKS IF THIS WASLAST000A 37600019 BNE LSTPOLPT ENTRY POLLED IF NOT GO TO NEXT 000A 37700019 LA R8,LSTONE(R9) YES SET POINTER TO POLLING 000A 37800019 B LSTRDTIA NO USE POINTER IN REG 8 000A 37900019 *********************************************************************** 38000019 * THIS ROUTINE DOES A BTAM RELEASE BUFFER. THIS ROUTINE IS ENTERED * 38100019 * BECAUSE OF A LINE FAILURE OR A RESET POLL * 38200019 *********************************************************************** 38300019 LSTRBUFF L R6,DECDCBAD LOADS DCB ADDRESS 38400019 L R10,LCBBUFER LOADS DISK BUFF PTR A22264 38500019 LA R10,LSTQMPA(R10) ADJUST PTR PAST QMPA A26531 38600019 L R7,DECAREA LOADS LINE BUFF PTR A22264 38700019 LA R7,0(R7) ZERO OUT HI ORDER BYTE A22264 38750020 CR R7,R10 ARE THEY = YES SKIP RELEASE A22264 38800019 BCR 8,R8 BUFF WRONG BUFFER A22264 38900019 SR R9,R9 CLEAR REG FOR STORE A24701 39000019 ST R9,0(R7) IN BTAM BUFFER A24701 39100019 RELBUF (6),(7) AT START OF ROUTINE 39200019 BR R8 39300019 *********************************************************************** 39400019 * THIS ROUTINE IS THE RJENDC PROCEDURE TO COAST RJE TO A HALT. THIS * 39500019 * ROUTINE INSURES THAT EACH LINE IS INACTIVE WHEN THE SYSTEM IS TO BE* 39600019 * SHUT DOWN. IT GENERATES A RJENDC FOR THE RJE SYSTEM AND WAITS * 39700019 * UNTIL A CLOSE DOWN MESSAGE IS GENERATED THEN POSTS THAT TERMINALS * 39800019 * STOP RJE ECB TO DEACTIVATE * 39900019 *********************************************************************** 40000019 LSTSTOP CLI LCBTYPLN,LCBMULPT CHECK FOR MULTIPOINT 000A 40100019 BE LSTMDGOA PROCESS MULTIDROP 000A 40200019 L R6,LCBTDIR LOAD TDIR ENTRY POINTER 000A 40300019 LTR R6,R6 CHECKS FOR NO TERM THIS LINE 40400019 BC 8,LSTFINI IF NO TERM GO TO EXIT 40500019 LSTMDGOA CLI LCBFLAG,LSTCGONE TESTS IF RJENDC MSG GONE 40600019 BE LSTPOST 40700019 CLI LCBFLAG,LSTDISP CHECKS IF MSG IS ENQUEUED 40800019 BE LSTROUTB 40900019 LSTROUTC CLI LCBFLAG,LSTLRDC CHECKS IF IHKABLRD GENERATED RJENDC 41000019 BE LSTROUTA 41100019 CLI LCBTYPLN,LCBMULPT CHECKS FOR NON-SWITCHED LINE 41200019 BE LSTNSWH 41300019 LSTMDGO MVI LCBFLAG,LSTLRDC SETS ROUTA FLAG TO EXIT 41400019 SR R1,R1 SET A 0 IN REG1 FOR RJENDC AND GOES 41500019 ST R1,LCBPARM1 STORES RJEND CODE IN LCB 41600019 L R5,LSTCOCOM SET BASE FOR DSECT 41700019 ST R2,IHKZZLCB STORE LCB POINTER IN PARM LIST 41800019 LA R1,IHKZZLCB LOADS POINTER TO PARM LIST 41900019 L R15,LSTABRJF TO LRD TO GET COMMAND BUILT AND QUED 42000019 BR R15 42100019 LSTROUTA MVI LCBFLAG,LSTDISP SETS ROUTEB FLAG AND GOES TO DIS- 42200019 L R1,LCBDDECB LOADS ECB POINTER FOR WAIT 42300019 MVI 0(R1),LSTDZERO ZEROES WAIT BIT IN ECB 42400019 L R15,LSTAADSP PATCHER TO WAIT FOR RJEND TO INDICAT 42500019 BALR 14,15 E MESSAGE IS READY 42600019 B LSTSTOP 42700019 LSTROUTB MVI LCBFLAG,LSTCGONE SETS MSG GONE (RJENDC) 42800019 TM TDIRSWCH+1,LSTDSCNT TESTS FOR DISCONTINUED TERMINAL IF 42900019 BO LSTPOST SO FORGET MSG NOT SENT 43000019 B LSTLWREX GO TO IHKABLWR 43100019 LSTPOST TM TDIRSWCH+2,LSTDCNTC CHECKS FOR A CONTENTION 43200019 BO LSTCONT ON WRITING RJENDC MSG 43300019 MVI LCBFLAG,LSTDZERO RESETS MSG GONE FLAG 000A 43400019 MVI TDIRSECB,LSTPOSTT POSTS THIS TERMINAL AS CLOSEDOWN 43500019 CLI LCBTYPLN,LCBMULPT CHECKS FOR A MULTI-POINT LINE 43600019 BE LSTNSWH 000A 43700019 LSTMDONE L R1,LCBDDECB AND TO DISPATCHER TO AWAIT RJE 43800019 MVI 0(R1),LSTDZERO CLOSEDOWN 43900019 L R15,LSTAADSP 44000019 BR R15 GO TO DISPATCHER 44100019 *********************************************************************** 44200019 * THIS ROUTINE CREATES AN RJENDF FOR WARMSTART * 44300019 *********************************************************************** 44400019 LSTRJNDF L R5,LSTCOCOM ESTABLISHES BASE FOR DSECT 44500019 L R4,IHKZZTDR LOADS BEGINNING OF TDE 44600019 L R7,IHKZZTLN LOADS LENGTH OF EACH TDE 44700019 LH R7,0(R7) LOADS VALUE OF LENGTH 44800019 L R8,IHKZZTNB LOADS TOTAL NUMBER OF TDE'S 44900019 LH R11,0(R8) LOADS TOTAL NUMBER 45000019 LA R11,1(R11) ADD ONE TO COUNT 45100019 LSTRJCH TM LSTSAVE+1,LSTRJC TEST IF CONTROL SHOULD GO TO RJENDC 45200019 LA R10,LSTRJCH ROUTINE AND SETS UP RENTRY POINT 45300019 BO LSTRJCPT GO IF SWITCH IS ON 45400019 LSTRJCH1 TM TDIRSWCH,LSTRJSTR CHECKS TO SEE IF TERMINAL HAS 45500019 LA R10,LSTRJCH1 ALREADY RJENDED 45600019 BC 8,LSTINDEX 45700019 ST R4,LCBTDIR STORES CURRENT TDIR ENTRY IN LCB 45800019 LH R1,LSTCODE SET CODE FOR PROPER RJEND IN REG1 45900019 LA R10,LSTEXLRD AND EXIT TO IHKABLRD EXIT 46000019 B LSTINDEX 46100019 LSTEXLRD ST R1,LCBPARM1 STORES RJEND CODE IN LCB 46200019 LSTRJLRD L R5,LSTCOCOM SET BASE FOR DSECT 46300019 ST R2,IHKZZLCB STORE LCB POINTER IN PARM LIST 46400019 OI LCBLDECB,LCBZTDRN SETS ZERO LCBTDIR FLAG 000B 46500020 LA R1,IHKZZLCB LOADS POINTER TO PARM LIST 46600019 L R15,LSTABRJF GO TO RJENDF ROUTINE 46700019 BR R15 46800019 LSTINDEX AR R4,R7 INDEXES POINTER TO NEXT TDE 46900019 BCTR R11,R10 CHECKS FOR LAST TDE 47000019 B LSTCHECK RETURNS TO CALLING SUBROUTINE 47100019 LSTENDRF MVI LSTSAVE,LSTDZERO RESETS RJEND FIRSTIME SWITCH 47200019 XC LCBTDIR,LCBTDIR ZEROES TDIR PTR IN LCB 000A 47300019 L R8,LSTCDRCS 47400019 NI 0(R8),LSTRESET RESETS WARMSTART BIT 47500019 B LSTBEGIN BEGINNING 47600019 *********************************************************************** 47700019 * THIS ROUTINE SETS UP A DUMMY WAIT FOR ENTRY INTO THE DISPATCHER * 47800019 * UNTIL THE SYSDEQ ROUTINE FINISHES POLICING THE SYSOUT QUEUE * 47900019 * ALSO STORES REGISTERS FOR RETURN FROM DISPATCHER * 48000019 *********************************************************************** 48100019 LSTOUTSP MVI LCBFLAG,LSTDZERO RESETS RJEND SWITCH 48200019 LSTRIDE SR R14,R14 48300019 L R1,LCBLDECB LOADS ECB POINTER IN REG1 48400019 LA R15,LSTBEGIN 48500019 STM R14,R12,12(R13) STORES OWN REGISTERS FOR RETURN 48600019 L R15,LSTAADSP LOADS ADDRESS OF DISPATCHER 48700019 BR R15 GO TO DISPATCHER 48800019 *********************************************************************** 48900019 * THIS ROUTINE DETERMINES WHAT TERMINAL ON A MULTI-DROP LINE. THIS * 49000019 * DONE BY PICKING UP ITS POLLING CHARACTERS FROM THE DEFINE TERMINAL * 49100019 * LIST AND COMPARING THEM AGAINST THE POLLING CHARACTERS IN THE * 49200019 * TERMINAL TABLE. WHEN AN EQUAL COMPARE OCCURS THE CORRESPONDING * 49300019 * TERMINAL DIRECTORY ENTRY IS PLACED IN THE LINE CONTROL BLOCK. THEN * 49400019 * CONTROL IS PASSED TO IHKABLRD * 49500019 *********************************************************************** 49600019 LSTMUTCK EQU * 000A 49700019 LA R15,LSTCKGD SET RETURN ADDRESS 000A 49800019 LSTCKBD EQU * 000A 49900019 LA R5,LSTEXCTE SET RETURN ADDRESS 000A 50000019 LTR R4,R4 TEST FOR TDIR POINTER M2642 50110019 BC 8,NOTEST NO DONT DO CHECK M2642 50120019 TM TDIRSWCH+2,TDIRCDSN TEST FOR INTERNAL DISCONTINUE M2642 50130019 BO LSTRDEXT YES NO NEED TO DO IT LEAVE M2642 50160019 NOTEST EQU * M2642 50180019 L R7,LCBCTMTB LOADS TERMINAL TABLE POINTER 000A 50200019 LA R7,LSTSIXX(R7) STEP PAST FIRST SIX BYTES 000D 50300019 L R8,DECENTRY LOADS PTR TO ENTRY IN DFTRMLST 000A 50400019 L R9,LCBDFTRM LOADS PTR TO BEGINNING OF DFTRM 000A 50500019 BCTR R9,R0 LST AND ADJUSTS PTR TO ITS HEADR000A 50600019 SR R10,R10 FROM IT THE WIDTH OF EACH ENTRY 000A 50700019 IC R10,LSTZEROO(R9) IS OBTAINED AFTER SHIFTING OF 000A 50800019 SRL R10,LSTFIVE UN-NECESSARY BITS AND REDUCING 000A 50900019 S R10,LSTTO THE WIDTH TO ELIMINATE CONSTANT 000A 51000019 * REGION. 000A 51100019 BR R5 000A 51200019 LSTEXCTE EX R10,LSTCOMPR COMPARES POLL CHARS OF BOTH 000A 51300019 BE LSTMOVE TABLES,CHECKING FOR = COMPARE 000A 51400019 LA R7,LSTFIVE(R10,R7) INDEX TO NEXT ENTRY IN TERMINAL 000D 51500019 B LSTEXCTE TABLE AND EXECUTES ANOTHER COMP 000A 51600019 LSTMOVE EQU * 000D 51700019 LA R7,LSTONE(R10,R7) SET ADDRESS PAST POLL CHARS 000D 51800019 MVC LCBTDIR+1(LSTTHREE),LSTONE(R7) MOVE TDE TO LCB 000D 51900019 BR R15 IF ENTRY WAS AT LSTMUTCH, 000A 52000019 * EXIT TO LSTCKGD. 000A 52100019 * IF ENTRY WAS AT LSTCKBD, 000A 52200019 * EXIT TO LSTHERE. 000A 52300019 LSTCKGD TM LSTZEROO(R7),LSTHIBIT CHECK FLAG IN TERM TABLE 000D 52400019 BNO LSTRDEXT TERM HAS BEEN RESPONDING NORMALY000A 52500019 * CALL IHKABLRD 000A 52600019 NI LSTZEROO(R7),LSTHIBTF TERM HAS FINALLY RESPONDED 000D 52700019 * TURN OFF ERROR SWITCH 000A 52800019 L R4,LCBTDIR GET TERMINAL DIRECTORY ENTRY 000A 52900019 MVC LSTTRMGD,TDIRTERM PUT TERMID TO MSG 000A 53000019 LA R1,LSTGDMS PASS MSG TO WTO 000A 53100019 SVC 35 SEND TERM NOW RESPONDING MSG 000A 53200019 B LSTRDEXT NOW CALL IHKABLRD 000A 53300019 *********************************************************************** 53400019 * THIS ROUTINE CHECKS ALL TERMINALS ON A MULTI-DROP LINE * 53500019 * FOR OUTPUT IF NO OUTPUT EXIST IT RETURN TO THE READ INITIAL * 53600019 *********************************************************************** 53700019 LSTNSWCH EQU * 000D 53800019 BAL R5,NOTEST GET ENTRY WIDTH OF POLL CHARS A37794 53900020 LR R4,R10 THEN ADD CONSTANT OF FOR TO 000D 54000019 LA R5,LSTONE(R4) SET ENTRY WIDTH OF POLL CHARS 000D 54100019 LA R4,LSTFIVE(R4) SET ENTRY WIDTH OF TERM TABLE 000D 54200019 L R9,LCBCTMTB LOADS TERMINAL TABLE POINTER 000D 54300019 L R11,LSTZEROO(R9) LOADS CURR TERM TABLE POINTER 000A 54400019 LR R8,R9 000A 54500019 SR R7,R7 000A 54600019 IC R7,LCBTABNM LOADS NUM OF ENTRIES IN TERM TBL000A 54700019 MR R6,R4 FINDS TOTAL LENGTH OF TABLE 000A 54800019 AR R8,R7 SETS POINTER TO END OF TABLE 000A 54900019 LA R8,LSTSIXX(R8) ADD CONTROL WORD WIDTH 000D 55000019 LR R6,R4 NOT INDEX TO NEXT ENTRY AND 000D 55100019 LSTGOOF DS 0H 000B 55200019 LA R11,LSTZEROO(R6,R11) GO TO 000D 55300019 CR R11,R8 CHECKS FOR END OF TABLE IF ENDOF000B 55400019 BE LSTSET TABLE SET FIRST TIME SWITCH IF 000B 55500019 LSTGETIT EQU * 000D 55600019 AR R11,R5 SET ADDRESS IN BY NUMBER OF 000D 55700019 * POLLING CHARACTERS 000D 55800019 MVC LCBTDIR(LSTFOUR),LSTZEROO(R11) MOVE TDE TO LCB 000D 55900019 SR R11,R5 SET ADDRESS BACK TO BEGINNING OF 000D 56000019 * THIS ENTRY 000D 56100019 L R4,LCBTDIR ORY POINTER FROM TERMINAL TABLE 000A 56200019 * TO LCB AND LOADS REG4 TO SET 000A 56300019 ST R11,LSTZEROO(R9) BASE OF DSECT AND EXIT TO OUTPUT000A 56400019 * CHECKER AFTER STORING CURR PTR 000A 56500019 BAL R10,LSTWRCHK IN THE TERMINAL TABLE 000A 56600019 L R11,LSTZEROO(R9) RELOADS CURR TERM TABLE POINTER 000A 56700019 B LSTGOOF 000B 56800019 LSTSET TM LSTFOUR(R9),LSTBDOP TEST FIRST TIME SWITCH 000A 56900019 BO LSTDONE IF ON ROUTINE IS FINISHED 000A 57000019 OI LSTFOUR(R9),LSTBDOP IF OFF SET ON AND RE-INITIALIZE 000A 57100019 LA R11,LSTSIXX(R9) TERMINAL TABLE POINTER TO BEGIN 000A 57200019 B LSTGETIT NING AND CHECK FOR OUTPUT AGAIN 000A 57300019 LSTDONE LA R11,LSTSIXX(R9) CLEAN UP RESETS FIRSTIME SWITCH 000A 57400019 ST R11,LSTZEROO(R9) RE-INITIALIZES CURRENT TERMINAL 000A 57500019 NI LSTFOUR(R9),LSTGIO TABLE POINTER TO BEGINNING AND 000A 57600019 B LSTDFIND EXIT TO THE READ INITIAL ROUTINE000A 57700019 *********************************************************************** 57800019 * THIS ROUTINE GENERATES A RJENDC FOR ALL TERMINALS ON A * 57900019 * MULTI-DROP LINE * 58000019 *********************************************************************** 58100019 LSTNSWH EQU * 000D 58200019 BAL R5,NOTEST GET ENTRY WIDTH OF POLL CHARS A37794 58300020 LR R11,R10 SAVE IT IN REG 11 000D 58400019 L R7,LCBCTMTB LOADS TERMINAL TABLE POINTER 000D 58500019 SR R9,R9 CLEARS REG 9 000A 58600019 TS LSTFIVE(R7) SETS FIRSTIME SWITCH TO SKIP 000A 58700019 BC 7,LSTSKIP THE FOLLOWING INSTRUCTION 000A 58800019 LA R6,LSTSIXX(R7) INDEX POINTER PAST TABLER HRDR 000A 58900019 IC R9,LCBTABNM INSERTS # OF ENTRIES IN TABLE 000A 59000019 B LSTTEST2 000A 59100019 LSTSKIP L R6,LSTZEROO(R7) LOADS CURRENT ENTRY IN TERM TABL000A 59200019 IC R9,LSTFOUR(R7) INSERTS NUMBER OF ENTRIES LEFT 000A 59300019 LSTTEST2 LTR R9,R9 TESTS IF ANY LEFT TO PROCESS 000A 59400019 BC 8,LSTMDONE NO THATS ALL 000A 59500019 LR R14,R6 SAVE REG FOR OTHER USE 000D 59600019 LA R14,LSTONE(R11,R14) SET TO POINT TO TDIR ADDRESS 000D 59700019 MVC LCBTDIR(4),LSTZEROO(R14) MOVES ADDRESS POINTER TO 000D 59800019 L R4,LCBTDIR WORDBOUNDRY AND LOADS IN REG 4 000A 59900019 LA R10,LSTTEST2 SETS RETURN TO TEST NEW TERM 000A 60000019 TM TDIRSWCH,LSTRJSTR TEST IF TERM HAS RJENDED 000A 60100019 BZ LSTADDIX YES GO TO NEXT ONE 000A 60200019 LA R10,LSTMDGO SET RETURN TO GO PROCESS RJENDC 000A 60300019 LSTADDIX BCTR R9,R0 DECREASE COUNT BY ONE 000A 60400019 STC R9,LSTFOUR(R7) STORE COUNT IN TERM TABLE 000A 60500019 LA R6,LSTFIVE(R11,R6) SET TO NEXT TABLR ENTRY 000D 60600019 ST R6,LSTZEROO(R7) STORE NEW POINTER IN TERM TABLE 000A 60700019 BR R10 RETURN 000A 60800019 *****************************************************************A47940 60802021 * THIS ROUTINE PERMITS THE 2770 OPERATOR TIME TO UNLOAD *A47940 60804021 * THE STACKER OR RECOVER FROM A CARD JAM *A47940 60806021 *****************************************************************A47940 60808021 REREAD CLI LCBTYPLN,LCBSWTCH FOR A NON-SWITCHED LINE, A47940 60810021 BNE LSTRDTI JUST TRY AGAIN A47940 60812021 LSTRDTQ LA R6,9 SET LOOP COUNTER FOR READ ENQ A47940 60814021 BAL R14,LSTCLRBF INITIALIZE FOR WRITE A47940 60816021 OI DECTYPE,X'40' INDICATE NO BTAM ERR MSG ON TIMEOUTA47940 60818021 WRITE (1),TN,MF=E WRITE RESET AND GET ENQ RESPONSE A47940 60820021 LA R9,LSTCKTIM SET ERROR RETURN EXIT A47940 60822021 BAL R10,LSTRDTST CHECK FOR SUCCESSFUL READ A47940 60824021 CLI DECRESPN,X'2D' CHECK FOR ENQ A47940 60826021 BE LSTREAD YES - DO READ CONTINUE A47940 60828021 CLI DECRESPN,X'37' CHECK FOR EOT A47940 60830021 BE LSTRDTQ YES - REPEAT WRITE RESET A47940 60832021 B LSTBDRD INVALID CHAR - DO RJENDF A47940 60834021 SPACE 60836021 LSTRDTQR OI DECTYPE,X'40' NO BTAM ERR MSG ON TIMEOUT, PLEASE A47940 60838021 LR R0,R6 SAVE LOOP COUNTER A47940 60840021 BAL R9,LSTWMSTP CHECK STOP BIT A47940 60842021 LR R6,R0 RESTORE LOOP COUNTER A47940 60844021 READ (1),TQ,MF=E READ ENQ A47940 60846021 LA R10,LSTREAD SET NORMAL RETURN EXIT A47940 60848021 BAL R9,LSTRDTST CHECK FOR SUCCESSFUL READ A47940 60850021 LSTCKTIM TM DECSENS0,X'01' READ UNSUCCESSFUL - TEST IF TIMEOUTA47940 60852021 BZ LSTBDRD NO - DO RJENDF A47940 60854021 BCT R6,LSTRDTQR YES - REPEAT READ ENQ 7 TIMES A47940 60856021 B LSTBDRD DO RJENDF AFTER 8 READ ENQ TRIES A47940 60858021 SPACE 60860021 LSTREAD LA R14,LSTREAD1 INITIALIZE FOR READ CONTINUE A47940 60862021 LSTCLRBF L R1,LCBLDECB ROUTINE TO INITIALIZE FOR I/O A47940 60864021 LR R3,R1 SET REGS 1 & 3 TO LINE DECB A47940 60866021 L R15,DECAREA ZERO FIRST WORD OF BUFFER A47940 60868021 XC 0(4,R15),0(R15) A47940 60870021 BR R14 RETURN TO CALLER A47940 60872021 LSTREAD1 BAL R9,LSTWMSTP CHECK STOP BIT A47940 60874021 READ (1),TT,MF=E READ CONTINUE A47940 60876021 B LSTRETST RETURN TO PROCESS INPUT A47940 60878021 SPACE 60880021 STKUN DC X'10022D' DLE-STX-ENQ MEANS 2770 STACKER UNLOAD A47940 60882021 CDJAM DC X'37022D' EOT-STX-ENQ MEANS 2770/2780 CARD JAM A47940 60884021 *********************************************************************** 60900019 * THIS IS A COMMON IHKABLRD EXIT ROUTINE * 61000019 *********************************************************************** 61100019 LSTLRDEX CLI LCBTYPLN,LCBMULPT TESTS FOR MULTI-DROP LINE IF SO 61200019 BE LSTMUTCK EXITS TO MULTI-DROP INPUT ROUTINE 61300019 LSTRDEXT L R15,LSTABLRD 61400019 L R5,LSTCOCOM SET BASE FOR DSECT 61500019 ST R2,IHKZZLCB STORE LCB POINTER IN PARM LIST 61600019 LA R1,IHKZZLCB LOADS POINTER TO PARM LIST 61700019 BR R15 THIS IS A COMMON IHKABLRD EXIT 61800019 *********************************************************************** 61900019 * THIS IS A COMMON EXIT ROUTINE TO THE LINE WRITE ROUTINE * 62000019 *********************************************************************** 62100019 LSTLWREX L R15,LSTABLWR THIS IS A COMMON IHKABLWR EXIT 62200019 L R5,LSTCOCOM SET BASE FOR DSECT 62300019 ST R2,IHKZZLCB STORE LCB POINTER IN PARM LIST 62400019 LA R1,IHKZZLCB LOADS POINTER TO PARM LIST 62500019 BR R15 62600019 *********************************************************************** 62700019 * THIS IS A COMMON EXIT ROUTINE TO THE DISPATCHER 62800019 *********************************************************************** 62900019 LSTDSPEX L R1,LCBLDECB LOAD ECB POINTER FOR WAIT 63000019 LSTDSPE2 LA R14,LSTBEGIN LOADS 14 WITH THE RETURN ADDRESS 63100019 L R15,LSTAADSP LOADS DISPATCHER ENTRY POINT 63200019 BR R15 THIS IS A COMMON IHKAADSP EXIT 63300019 *********************************************************************** 63400019 * THIS IS A COMMON RJENDF ROUTINE * 63500019 *********************************************************************** 63600019 LSTRJEDF LTR R4,R4 CHECKS FOR TDE POINTER 000A 63700019 LA R8,LSTRDTI SET RENTRY PT FOR REL BUFF A47940 63800021 BC 7,LSTRBUFF NO - DONT BUILD RJENDF A47940 63850021 TM TDIRSWCH,LSTRJSTR CHECKS IF TDE HAS RJSTARTED 000A 63900019 BZ LSTRBUFF NO - DONT BUILD RJENDF A47940 64000021 SPACE 64100019 SPACE 64200019 SR R1,R1 64300019 LH R1,LSTCODEF THIS CODE INDICATES TO IHKABLRD THAT 64400019 B LSTEXLRD IT SHOULD GENERATE A RJENDF 64500019 LSTRJCCK TM LSTSAVE+1,LSTRJC CHECKS IF RJENDC SWITCH IS SET 64600019 BO LSTSTOP 64700019 L R6,LCBTDIR SAVES TDIR POINTER IN LCB FOR LATER 64800019 ST R6,LSTSAVE+4 RESTORE 64900019 OI LSTSAVE+1,LSTRJC SET A SWITCH INDICATING A RJENDC 65000019 B LSTRJNDF INSTEAD OF RJENDF 65100019 LSTRJCPT TM TDIRSWCH,LSTRJSTR TESTS FOR A RJENDED TERNINAL IF SO 65200019 BZ LSTINDEX SKIP TERMINAL ***************** 65300019 TM TDIRSTAT,LSTTEN TESTS ENQUEUE MSG SWITCH IF ON TER 65400019 BO LSTINDEX MINAL HAS NOT FINISHED RETURN 65500019 CLC TDIRFQEB+1(3),LSTZEROQ CHECKS IF ALL MSG ARE GONE 65600019 BNE LSTINDEX IF NOT RETURN 65700019 MVI TDIRSECB,LSTPOSTT POSTS ECB IN TDE INDICATING TERMINAL 65800019 B LSTINDEX CLOSE DOWN CDMPLETE 65900019 LSTCHECK TM LSTSAVE+1,LSTRJC THIS ROUTINE CHECK TYPE OF RJEND 66000019 BO LSTZERO SWITCH ON RJENDC 66100019 B LSTENDRF SWITCH OFF RJENDF 66200019 LSTZERO L R6,LSTSAVE+4 RESTORE TERMINAL DIRECTORY POINTER 66300019 ST R6,LCBTDIR TO LCB SO IT CAN BE PROCESSED 66400019 MVI LSTSAVE+1,LSTRJC RESETS RJENDC SWITCH 66500019 CLI LCBTYPLN,LCBMULPT CHECKS FOR MULTI-DROP LINE 000A 66600019 BE LSTNSWH 000A 66700019 LTR R6,R6 TESTS IF TDE POINTER IN LCB IS ZERO 66800019 BC 8,LSTFINI IF SO NO TDE ON THIS LINE FINISHED 66900019 B LSTSTOP IF SO GO TO STOP ROUTINE 67000019 *********************************************************************** 67100019 * THIS IS A COMMON ROUTINE THAT CHECKS FOR STOP AND WARMSTART * 67200019 *********************************************************************** 67300019 LSTWMSTP L R6,LSTCDRCS LOADS POINTER TO IHKCDRCS 67400019 TM 0(R6),LSTRDER CHECKS TO SEE IF READER HAS FINISHED 67500019 BO LSTRIDE WARMSTART 67600019 TM 0(R6),LSTWRMB TESTS FOR WRMSTART IF ON GENERATES 67700019 BO LSTRJNDF A RJENDF FOR EACH ACTIVE TERMINAL 67800019 TM 0(R6),LSTWJDAB CHECKS TO SEE IF SYSDEQ HAS FINISHED 67900019 BO LSTRIDE IF NOT GOES TO DISPATCHER TO WAIT 68000019 TM 0(R6),LSTSTPB TESTS FOR STOP RJE BIT,IF ON GOES 68100019 BO LSTRJCCK TO RJENDC PROCEDURE 68200019 BR R9 IF NO BIT ARE SET RETURN 68300019 *********************************************************************** 68400019 * THIS ROUTINE IS DESIGNED TO KEEP A SWITCHED OPEN UNTIL THERE IS * 68500019 * EITHER OUTPUT FOR THE REMOTE OR INPUT FROM THE REMOTE. THE LINE * 68600019 * WILL REMAIN OPEN INTIL THE USER DESIRES TO HANG UP BY RJENDING * 68700019 *********************************************************************** 68800019 IHKABEOT EQU * 68900019 L R3,LCBLDECB LOADS BASE FOR DECB DSECT 69000019 L R4,LCBTDIR LOADS BASE FOR TDIREC DSECT 69100019 LSTWREOT LR R1,R3 69200019 OI DECTYPE,LSTTOFLG INDICATE NO BTAM ERROR MESSAGE 000A 69300019 * FOR TIME OUT 000A 69400019 MVI DECRESPN,LSTDZERO ZEROES DECB RESPONSE FIELD 69500019 WRITE (1),TN,MF=E WRITES EOT FOR SWITCHED LINE 69600019 LA R9,LSTOUTP SET ERROR RETURN EXIT 000D 69700019 BAL R10,LSTRDTST SETS NORMAL RETURN EXIT 000A 69800019 LSTEOTCK CLI DECRESPN,LSTEOT CHECK IF THE RESPONSE TO THE EOT WAS 69900019 BE LSTABOUT AN EOT IF SO NO INPUT FROM REMOTE 70000019 CLI DECRESPN,LSTENQ CHECK IF THE RESPONSE WAS AN ENQ 70100019 BE LSTDISCT ENQ MEANS REMOTE I/P A53111 70200021 B LSTOUTP 2780 GO DO READ ENQ 000A 70300019 LSTABOUT BAL R9,LSTWMSTP CHECK FOR STOP RJE 70400019 BAL R10,LSTWRCHK GO TO CHECK FOR OUTPUT ROUTINE 70500019 L R4,LCBTDIR SETS BASE FOR DSECT 000A 70600019 LSTWAIT L R1,LCBLDECB LOADS ECB POINTER 000A 70700019 OI DECTYPE,LSTTOFLG INDICATE NO BTAM ERROR MESSAGE 000A 70900019 * FOR TIME OUT 000A 71000019 L R8,LSTREIGH(R1) LOADS DCB POINTER 000D 71100019 OI LSTRFIVE(R8),LSTHIBIT SET FLAG FOR IMMED INTERP ON 000D 71200019 READ (1),TQ,MF=E DOES A READ ENQ 000A 71300019 LA R10,LSTDISCT SET RENTRY FOR ENQ RECEIVED A53111 71400021 BAL R9,LSTRDTST GOES TO TEST I/O ROUTINE 000A 71500019 LSTOUTP LR R3,R1 SETS BASE FOR DSECT 000A 71600019 TM DECSENS0,LSTTIMO TEST IF ERROR WAS A TIME OUT 000A 71700019 BZ LSTRJED NO GO DO RJENDF 000A 71800019 B LSTABOUT GO CHECK FOR OUTPUT 000D 71900019 LSTRJED LH R1,LSTFF SETS CODE FOR RJENDF 000A 72000019 B LSTRJEDF NO OUTPUT AVAILABLE DO RJENDF 000A 72100019 *********************************************************************** 72200019 * THIS ROUTINE HANDLES A CONTENTION PROBLEM WHILE THE WRITER IS TRYING* 72300019 * TO WRITE THE CLOSE DOWN MESSAGE IT READS THE INCOMING DATA AND * 72400019 * RESPONDS WITH AN EOT TO ABORT THE TRANSMISSION * 72500019 *********************************************************************** 72600019 LSTCONT MVI LCBFLAG,LSTDISP RESETS ROUTEB FLAG 000A 72700019 CLI LCBTYPLN,LSTMDSW CHECKS FOR MSG GONE INDICATOR 000A 72800019 BE LSTWREOT 72900019 L R1,LCBLDECB LOADS ECB POINTER 73000019 LR R3,R1 SETS BASE FOR DSECT 000A 73100019 READ (1),TT,,'S','S',MF=E READ TO CLEAR LINE 000A 73200019 LA R9,LSTSKIP2 SET UP RETURN ADDRESS 1657 73300019 BAL R10,LSTRDTST SETS NORMAL RETURN EXIT 000A 73400019 WRITE (1),TN,MF=E WRITES EOT AND GOES 73500019 LA R9,LSTRESPL SET ERROR EXIT 000A 73600019 BAL R10,LSTRDTST SETS NORMAL RETURN EXIT 000A 73700019 B LSTLWREX GOES BACK TO IHKABLWR TO SEND MSG 73800019 *********************************************************************** 73900019 * THIS ROUTINE DOES A DISABLE IF THERE IS AN ERROR ON A READ INITIAL * 74000019 * OPERATION ON A SWITCHED LINE * 74100019 *********************************************************************** 74200019 LSTHNGUP CLI LCBTYPLN,LCBSWTCH CHECK TO SEE IF ITS A SWITCHED LINE 74300019 BNE LSTRBUFF NO GO TO RELEASE BUFF ROUTINE A29519 74400020 L R1,LCBLDECB YES WRITE AN EOT DISABLE 74500019 WRITE (1),TD,MF=E 74600019 LA R9,LSKIP SET ERROR RETURN EXIT A29519 74700020 BAL R10,LSTRDTST SETS NORMAL RETURN EXIT 000A 74800019 LA R8,LSTBEGIN SET RETURN ADDRESS 74900019 LSKIP EQU * A28208 74910020 LTR R4,R4 TEST FOR TDIR PTR A28208 74920020 BZ LAYAWAY NO SKIP ZERO FUNCTION A28208 74930020 XC TDIRLCB,TDIRLCB ZERO LCB PTR IN TDIR A28208 74940020 NI TDIRSWCH,TDIRRJSF TURN OFF RJSTART SWTCH A28208 74950020 LAYAWAY EQU * A28208 74960020 XC LCBTDIR,LCBTDIR ZEROES TDE POINTER 75000019 B LSTRBUFF GO TO RELEASE BUFFER ROUTINE 75100019 *********************************************************************** 75200019 * THIS ROUTINE DOES A WRITE TO OPERATOR INFORMING HIM THAT * 75300019 * RJE COULD NOT OPEN A PARTICLAR DCB * 75400019 *********************************************************************** 75500019 USING IHADCB,R4 75600019 LSTDDMSS MVC LSTPMSG1+LSTMSIN1(LSTEIGHT),DCBDDNAM MOVES DDNAME 75700019 * . INTO MSG 75800019 LA R1,LSTPMSG1 75900019 SVC 35 76000019 B LSTFINI 76100019 *********************************************************************** 76200019 * THIS ROUTINE INFORMS THE OPERATOR THAT A PARTICULAR LINE IS * 76300019 * PLACED IN AN INACTIVE STATE BECAUSE OF A NON-OPERATIONAL * 76400019 * CONTROL UNIT * 76500019 *********************************************************************** 76600019 LSTQUIT L R4,DECDCBAD LOADS ADDRESS OF DCB 76700019 L R5,DCBDEBAD LOADS ADDRESS OF DEB 76800019 SR R6,R6 CLEAR FOR IC A60657 76900021 IC R6,DECRLN DECB'S REL LINE # A60657 76920021 SLL R6,2 X 4 FOR INDEX IN DEB A60657 76940021 L R6,DEBUCBAD-4(R5,R6) UCB ADDRESS A60657 76960021 MVC LSTPMSG2+LSTMSIN2(LSTTHREE),UCBNAME(R6) MOVES LINE NAME 77000019 * INTO MSG 77100019 LA R1,LSTPMSG2 77200019 SVC 35 77300019 B LSTFINI GO WAIT FOR A CLOSEDOWN 77400019 *********************************************************************** 77410021 * THIS ROUTINE INFORMS THE OPERATOR THAT THE LINE TYPE A43087 77420021 * DEFINED IN THE UCB DOES NOT MATCH THE LINE TYPE AS A43087 77430021 * DEFINED BY THE RJE USER IN THE RJELINE MACRO. A43087 77440021 *********************************************************************** 77450021 LSTERR MVC LSTPMSG3+LSTMSIN2(LSTTHREE),UCBNAME(R6) MOVE LINE A43087 77460021 LA R1,LSTPMSG3 NUMBER INTO MSGE A43087 77470021 SVC 35 A43087 77480021 B LSTFINI GO WAIT FOR CLOSEDOWN A43087 77490021 *********************************************************************** 77500019 * THIS ROUTINE SEND AN ABORT EOT ON A SWITCHED LINE AND ALLOWS THE * 77600019 * 2780 NINE TIMEOUTS TO RECOVER AND SEND MORE INPUT * 77700019 *********************************************************************** 77800019 USING TDIREC,R4 000A 77900019 LSTABORT LA R6,LSTEIGHT LOAD A COUNT OF EIGHT FOR BCT 000A 78000019 L R3,LCBLDECB LOADS LINE DECB 000A 78100019 L R4,LCBTDIR LOADS TERM DIRECTORY POINTER 000A 78200019 LR R1,R3 000A 78300019 OI DECTYPE,LSTTOFLG INDICATE NO BTAM ERROR MESSAGE 000A 78400019 * FOR TIME OUT 000A 78500019 WRITE (1),TN,MF=E WRITE EOT 000A 78600019 LA R10,LSTEOTCK SET RETURN TO CHECK RESPONSE 000A 78700019 BAL R9,LSTRDTST SETS ERROR-RETuRN EXIT 000A 78800019 LSTESTIO CLI DECRESPN,LSTENQ TEST RESPONSE FIELD FOR ENQ. 000A 78900019 BE LSTDISCT IF ENQ IN GO READ CONTINUE A53111 79000021 TM DECSENS0,LSTTIMO TEST FOR TIME OUT 000A 79100019 BZ LSTRJEDF NO GO DO RJENDF 000A 79200019 LR R0,R6 SAVE LOOP COUNTER A53111 79220021 BAL R9,LSTWMSTP CHECK STOP BIT A53111 79240021 LR R6,R0 RESTORE LOOP COUNTER A53111 79260021 OI DECTYPE,LSTTOFLG INDICATE NO BTAM ERROR MESSAGE 000A 79300019 * FOR TIME OUT 000A 79400019 READ (1),TQ,MF=E YES READ ENQ FOR NINE TIMES 000A 79500019 LA R9,LSTCOUNT SETS ERROR RETURN EXIT 000A 79600019 BAL R10,LSTRDTST SETS NORMAL RETURN EXIT 000A 79700019 B LSTDISCT A53111 79800021 LSTCOUNT BCT R6,LSTESTIO COUNT NOT ZERO CHECK I/O 000A 79900019 B LSTRJEDF COUNT ZERO DO RJENDF 000A 80000019 *******************************************************************000D 80100019 * THIS ROUTINE DOES A BTAM LOPEN IT IS USED EXCLUSIVLY FOR IBM *000D 80200019 * WORLD TRADE MODEN 3977 MODEL2 *000D 80300019 *******************************************************************000D 80400019 LSTOPEN EQU * 000D 80500019 LOPEN (R3) DISABLES AND ENABLES THE LINE 000D 80600019 LTR R15,R15 DID LOPEN WORK ? (NO WAIT AFT)A37785 80700020 BZ LSTBEGIN YES, RETURN A37785 80800020 B LSTQUIT CONTROL UNIT FAILURE STOP 000D 80900019 LSTFINI L R1,LCBDDECB LOADS LINE ECB IN ONE AND SETS THE 81000019 MVI 0(R1),LSTDZERO COMPLETION BIT OFF IN ECB 81100019 LSTGDBYE B LSTDSPE2 AND GOES TO THE DISPATCHER TO AWAIT 81200019 * RJE CLOSE DOWN 81300019 LSTCOMPR CLC LSTZEROO(LSTZEROO,R7),LSTZEROO(R8) COMPARE FOR EXCUTE 81400019 LSTMVPOL MVC TDIRDFTA+3(LSTZEROO),LSTZEROO(R5) MOVE POLLING 000C 81500019 * CHARACTER(S) FROM TERMINAL 000A 81600019 * TABLE TO DFTRMLST IN TDIR 000A 81700019 LSTSAVE DC 2F'00' 000A 81800019 LSTWRBND DC F'00' 81900019 LSTCODE DC H'19' CODE INDICATING ABNORMAL CENTRAL BOMB 82000019 LSTABLST DC A(IHKABLST+2) ENTRY POINT IN LINE SHEDULER SETBASE 82100019 LSTAADSP DC V(IHKAADSP) ENTRY ADDRESS OF DISPATCHER 82200019 LSTABLRD DC V(IHKABLRD) ENTRY ADDRESS OF LINE ANALYSIS READ 82300019 LSTABLWR DC V(IHKABLWR) ENTRY ADDRESS OF LINE ANALYSIS WRITE 82400019 LSTZEROQ DC X'000000' CONTANT TO CHECK TDIRFQEB FOR ZERO 82500019 LSTABRJF DC V(IHKABRJF) ENTRY POINT TO LRD FOR RJENDF 82600019 LSTCDRCS DC V(IHKCDRCS) ADDRESS OF STOP AND WRMSTART SWITCHS 82700019 LSTTO DC F'03' FACTOR TO ELIIMNATE BTAM CONSTANTS 82800019 LSTSIX DC F'06' THIS VALUE IS LENGTH OF EACH ENTRY 82900019 * IN THE TERMINAL TABLE 83000019 LSTCODEF DC H'13' CODE INDICATOR TO IHKABLR THAT IT IS TO GEN- 83100019 * ERATE A RJENDF 83200019 LSTFF DC X'00FF' CODE FOR NO RJENDF MESSAGE 000A 83300019 LSTCOCOM DC V(IHKCACOM) ENTRY POINT TO AVT IN COMMAND INTERP 83400019 LSTERROR DC X'00000014' RETURN CODE SET BY BTAM FOR 83500019 * A NON OPERATIONAL CONTROL UNIT 83600019 LSTPMSG1 DC H'44' 83700019 DC X'8000' 000C 83800019 DC C' IHK065I UNABLE TO OPEN DDNAME=XXXXXXXX ' 83900019 DC X'10004000' MCS CODES FOR COI, SS 000C 84000019 LSTCAINT DC V(IHKCAINT) INCLUDED IN THIS ROUTINE TO FORCE 84100019 * LKED TO INCLUDE THIS ROUTINE THERE 84200019 * BY GETTING THE REST OF RJE 84300019 LSTPMSG2 DC H'38' 84400019 DC X'8000' 000C 84500019 DC C' IHK064I LINE XXX NOT OPERATIONAL ' 84600019 DC X'10004000' MCS CODES FOR COI, SS 000C 84700019 DS 0F A43087 84710021 LSTPMSG3 DC H'42' A43087 84720021 DC X'8000' A43087 84730021 DC C' IHK069I LINE XXX DEFINED INCORRECTLY ' A43087 84740021 DC X'10004000' MCS CODES FOR COI, SS A43087 84750021 DS 0F 000A 84800019 LSTGDMS DC AL2(LSTGDMSX-*) 000A 84900019 DC X'8000' 000C 85000019 DC C'IHK066I ' 000A 85100019 LSTTRMGD DC CL8' ',C' ' 000A 85200019 DC C'NOW RESPONDING TO POLLING' 000A 85300019 LSTGDMSX EQU * 000A 85400019 DC X'10004000' MCS CODES FOR COI, SS 000C 85500019 * 000A 85600019 DS 0F 000A 85700019 LSTBADMS DC AL2(LSTBDMSX-*) 000A 85800019 DC X'8000' 000C 85900019 DC C'IHK067I ' 000A 86000019 LSTTRMBD DC CL8' ',C' ' 000A 86100019 DC C'NOT RESPONDING TO POLLING' 000A 86200019 LSTBDMSX EQU * 000A 86300019 DC X'10004000' MCS CODES FOR COI, SS 000C 86400019 LSTZEROO EQU 0 DISPLACEMENT FACTOR 86500019 LSTONE EQU 1 DISPLACEMENT FACTOR 86600019 LSTTTWO EQU 2 DISPLACEMENT FACTOR 86700019 LSTFOUR EQU 4 DISPLACEMENT FACTOR 86800019 LSTFIVE EQU 5 DISPLACEMENT FACTOR 86900019 LSTSIXX EQU 6 DISPLACEMENT FACTOR 87000019 LSTREIGH EQU 8 DISPLACEMENT FACTOR 000D 87100019 LSTRFIVE EQU 35 DISPLACEMENT FACTOR 000D 87200019 LSTHIBIT EQU X'80' MASK OF 3RD BYTE OF TERM TABLE 000A 87300019 * ENTRY, INDICATES RESPONSE 000A 87400019 * STATE OF POLLED TERMINAL 000A 87500019 LSTHIBTF EQU X'7F' NEGATIVE OF ABOVE MASK 000A 87600019 LSTRDER EQU X'08' SWITCH FOR READER WARMSTART 000A 87700019 LSTTIMO EQU X'01' SENSE SETTING INDICATING TIME OUT 87800019 LSTTOFLG EQU X'40' TO INDICATE IN DECTYPE NO BTAM 000A 87900019 * ERROR MESSAGE FOR TIME OUT 000A 88000019 LSTTOOFF EQU X'BF' TO RESET DECTYPE FOR BTAM ERROR 000A 88100019 * MESSAGE FOR TIME OUT 000A 88200019 LSTWRITE EQU X'01' INDICATES PREVIOUS OPER WAS A WRITE 000A 88300019 LSTHIOP EQU X'04' SETTING FOR NEGATIVE RESPONSE TO000A 88400019 * POLLING 000A 88500019 LSTDSCNT EQU X'80' SWITCH INDICATING A DISCONTINUED TERMINAL 88600019 DCBBUFC EQU X'14' INDEX IN DCB TO BUFFER CONTROL BLOCK PTR 000A 88700019 LSTDZERO EQU X'00' USED TO ZERO ANY BYTE REFERENCE 88800019 LSTPOSTT EQU X'40' USED TO POST ECBS 88900019 LSTGIO EQU X'7F' CODE FOR GOOD BTAM RETURN 89000019 LSTHIO EQU X'48' CODE FOR RESET POLL BTAM RETURN 89100019 LSTCGONE EQU X'20' SWITCH INDICATING RJENDC MSG GONE 89200019 LSTRESET EQU X'BF' SETS OFF WARMSTART BIT 89300019 LSTDISP EQU X'80' SWITCH INDICATING GO TO DISPATCHER TO WAIT FOR 89400019 * RJENDC TO POST ECB INDICATING RJENDC MSG READY 89500019 LSTLRDC EQU X'40' SWITCH INDICATING GONE TO IHKABLRD TO HAVE 89600019 * RJENDC ENQUEUED 89700019 LSTMDSW EQU X'FF' SWITCH SET IN TERMINAL TABLE INDICATING THAT 89800019 * THIS TERMINAL HAS A RJENDC MSG GENERATED 89900019 LSTMSGON EQU X'FE' SWITCH SET IN TERMINAL TABLE INDICATING THAT 90000019 * THIS TERMINAL HAS RJENDC MSG SENT 90100019 LSTBDOP EQU X'80' SWITCH SET TO INDICATE THAT 2701,02,03 IS 90200019 * NOT OPERATIONAL 90300019 LSTRJC EQU X'08' SWITCH INDICATOR THAT A RJENDC IS DESIRED AND 90400019 * NOT RJENDF 90500019 LSTRTIB EQU * 000D 90600019 LSTNINE EQU 9 DISPLACEMENT FACTOR 000D 90700019 LSTMARK EQU 256 DISPLACEMENT FACTOR FOR MOVE OF TONE 000D 90800019 * CHARACTERS 000D 90900019 LSTMRK EQU 154 DISPLACEMENT FACTOR FOR MOVE OF TONE 000D 91000019 * CHARACTERS 000D 91100019 LSTQMPA EQU 48 DISPLACEMENT FOR QMPA A22264 91200019 LSTSYNC EQU X'32' LINE SYNC CHARACTER M2642 91250019 LSTMKCH EQU X'FF' TONE CHARACTERS FOR LINE 000D 91300019 LSTMAR EQU 257 DISPLACEMENT FACTOR 000D 91400019 LSTANST EQU X'FF' CHECK FOR AN SWLST WITH ID CHARS IN 000D 91500019 * DEFINE TERMINAL LIST 000D 91600019 DCBD DSORG=BX,DEVD=BS 91700019 IECTDECB 91800019 IHKDSECT TDIR,,,,LCB,AVT 91900019 END 92000019 ./ ADD SSI=03010889,NAME=IHKABLWR,SOURCE=0 LWR TITLE '''IHKABLWR'' - LINE ANALYSIS WRITE' 00050016 IHKABLWR CSECT 00100016 * 001500-006300,134000,322500,326000,335000,527500,692500,776500 19018 00200019 * 808000 19018 00300019 * 467000-469000,471500,492500,493000,497500,498000,807700,893000 A28214 00690019 * A28929 00691020 * 470100,471500 A29491 00692020 * A32841 00693020 * 128500-129000,207500,526000-526500 A32852 00694020 * A32869 00695020 * 453000 A32865 00697020 * A35881 00698020 *D127200,208300,515390-515420 A40162 00698520 *A515400 A40162 00699020 *C288200 A37798 00699520 *A532600-532700 A37762 00705521 *C773234 A44650 00711521 *A366750-366950 A47458 00712521 *A389100-389300 A47972 00713521 *D126000,503500-507000,510000-510500,754000,757500 A50147 00714521 *A127550,501540-501900,503100-506400,525600-525900 A50147 00715521 *A740060-740120,757200-757800 A50147 00716521 *A181810-181820 A48402 00717521 *D128000 A55909 00719521 *A127520 A55909 00723521 *D273000-274000,278500,291000 A47442 00727521 *A278500-278920,291000-291400,358100-358200,363070-363420, A47442 00731521 *A364600-364700,365030-365360,776250,803600-803700,839700 A47442 00735521 *C274700,275000-276000,839000 A47442 00739521 *D574000-574500 A57017 00743521 *A574000-574600 A57017 00763521 *D625100 A63558 00783521 *A625100-625120 A63558 00793521 *A363700 A66686 00803521 *C363210 A66686 00813521 * * 00823521 *TITLE 'IHKABLWR' - LINE ANALYSIS WRITE * 00833521 * * 00843521 * STATUS: CHANGE LEVEL 4, RELEASE 21.8 * 00853521 * * 00863521 *FUNCTION/OPERATION * 00950016 * THE BASIC PURPOSE IS TO OBTAIN THE DATA TO BE TRANSMITTED TO THE * 01000016 * REMOTE TERMINAL. * 01050016 * * 01100016 * THE TERMINAL DIRECTORY ENTRY CONTAINS THE POINTER TO THE FIRST OF * 01150016 * A CHAIN OF QEB'S, EACH OF WHICH DEFINES DATA TO BE TRANSMITTED. * 01200016 * EACH QEB IS DEQUEUED, PROCESSED, THEN RETURNED TO THE FREEPOOL. * 01250016 * * 01300016 * A MESSAGE QEB EITHER CONTAINS THE RJE MESSAGE TEXT WITHIN ITSELF * 01350016 * OR INDICATES THE LOCATION OF A MESSAGE STORED ON DISC. * 01400016 * * 01450016 * THE JOB QEB POINTES TO A FASTABLE ENTRY. WHICH POINTS TO A JED * 01500016 * ENTRY ON DISC, WHICH CONTAINS A Q MANAGER PARAMETER AREA AND THE * 01550016 * TTR IF THE FIRST OF A CHAIN OF DSB'S AND SMB'S, WHICH DEFINE A * 01600016 * SYSOUT DATA SET OR SYSTEM MESSAGE RESPECTIVELY. * 01650016 * * 01700016 * THE DSB CONTAINS AN ENTRY OF A TIOT WHICH IS USED BY IHKABLWR TO * 01750016 * CREATE A NEW TIOT REFERENCED BY THE OPEN, CHECK, AND CLOSE ROUTINE* 01800016 * TO PROVIDE ACCESS TO THE SYSOUT DATA SET. BSAM IS USED TO READ A * 01850016 * BLOCK OF SYSOUT DATA WHICH IS PASSED TO THE TRANSMITTING ROUTINE * 01900016 * (IHKABLWT) ONE LOGICAL RECORD AT A TIME ALONG WITH SUFFICIENT * 01950016 * IDENTIFYING INFORMATION SO THAT IHKABLWT CAN CREATE A HEADER TO * 02000016 * DESCRIBE THE DATA SET TO THE REMOTE STATION. ONCE TRANSMITTED, * 02050016 * THE DATA SET IS SCRATCHED. A TTR POINTER TO THE CURRECT BLOCK * 02100016 * BEING TRANSMITTED PERMITS RESUMPTION OF PROCESSING FROM THAT POINT* 02150016 * AFTER A DISCONTINUE SEQUENCE. OPTIONALLY, THE CONTINUE * 02200016 * MAY REQUEST EITHER STARTING OVER WITH THE ENTIRE DATA SET, OR * 02250016 * FORGETTING THE UNTRANSMITTED REMAINDER, ON RESUMING WITH THE * 02300016 * SAME BLOCK BEING PROCESSED WHEN HALTED. THE DISCONTINUE MAY BE * 02350016 * ORIGINATED BY THE REMOTE OPERATOR, EQUIPMENT FAILURE, OR BY THE * 02400016 * RECOGNITION OF A REQUEST FOR A CHANGE OF PRINTER FORMS. * 02450016 * * 02500016 * IN SUPPORT OF SYSTEM MANAGEMENT FACILITIES (SMF), THIS 19018 02508019 * ROUTINE NOW ALSO WRITES TYPE 6 OUTPUT WRITER RECORDS TO THE 19018 02516019 * SMF DATA SET. THIS RECORD, AS DESCRIBED IN THE DSECT LWSMF, 19018 02524019 * IS WRITTEN AT EACH CHANGE OF CLASS, FORM, OR JOB. 19018 02532019 * 19018 02540019 *ENTRY POINTS * 02550016 * * 02600016 * 'IHKABLWR'-PROCESS QEB'S ON TERMINAL QUEUE. CALLED ONLY BY * 02650016 * THE LINE SCHEDULER, IHKABLST. CALLING SEQUENCE IS * 02700016 * LA R1,PARLIST * 02750016 * L R15=V(IHKABLWR) * 02800016 * BR R15 * 02850016 * WHERE 'PARLIST' IS A ONE WORD PARAMETER LIST. THIS WORD IS THE * 02900016 * ADDRESS OF THE LCB. REGISTER 13 IS TO POINT TO THE SAME LINE * 02950016 * SAVE AREA USED BY THE LINE SCHEDULER ROUTINE. * 03000016 * * 03050016 *INPUT - * 03100016 * THE QEB CHAIN ATTACHED TO A TERMINAL DIRECTORY ENTRY- * 03150016 * THE DSB/SMB CHAIN ATTACHED TO A PARTICULAR JOB QEB- * 03200016 * SYSOUT DATA SPECIFIED BY A DSB- * 03250016 * VARIOUS TYPES OF MSG QEB'S AND SMB'S- * 03300016 * * 03350016 *OUTPUT- * 03400016 * LCBPARM2 POINTS TO A LOGICAL REGORD TO BE TRANSMITTED. * 03450016 * LCBPARM1 HAS THE LENGTH IN BYTES OF THAT RECORD. * 03500016 * LCBWORKA HAS THE ADDRESS OF A WORKAREA WHICH CONTAINS A DESCRIPTION 03550016 * OF THE DATA BEING SENT. * 03600016 * * 03650016 *EXTERNAL ROUTINES- * 03700016 * IHKAADSP-DISPATCHER, TO WAIT FOR SYSOUT DATA TO BE READ. * 03750016 * IHKABLWT-TRANSMITS DATA TO TERMINALS * 03800016 * IHKABRER-DETERMINES WHETHER A SYSOUT DATA SET MAY BE OPENED. * 03850016 * IHKCDRMV - SCRATCHES THE SYSOUT DATA SET. * 03900016 * IHKQMNGR-IN SEPARATE TASK, LINKS TO IEFQDELE AND 000A 03950016 * IEFQMSSS TO READ AND DELETE DSB/SMB CHAINS. 000A 04000016 * IHKCDMDQ-READS AN RJE DELAYED MESSAGE TEXT OR A BRDCST * 04050016 * MESSAGE TEXT FROM DISC TO CORE * 04100016 * BSAM-READS SYSOUT DATA * 04150016 * * 04200016 *EXITS-NORMAL- * 04250016 * R15 = 0 WHEN TERMINAL QUEUE IS EMPTY. (NON-SWITCHED) * 04300016 * R15 = 4 WHEN DISCONTINUED. (NON-SWITCHED) * 04350016 * R15 = 8 WHEN HALTING TRANSMISSION TO SWITCHED LINES. * 04400016 * * 04450016 *EXITS-ERROR- * 04500016 * R15 = 16 WHEN DISCONTINUING AFTER LINE FAILURE. (RJENDF) * 04550016 * * 04600016 *TABLES, WORKAREAS- * 04650016 * RJE LINE CONTROL BLOCK- ADDRESS IN REGISTER 2. * 04700016 * TERMINAL DIRECTORY ENTRY- ADDRESS IS IN LINE CONTROL BLOCK * 04750016 * FASTABLE ENTRY- ADDRESS IN JOB QEB * 04800016 * JEDTABLE ENTRY- TTR ADDRESS IS IN FASTABLE ENTRY * 04850016 * LINE SAVE AREA- ADDRESS IS IN REGISTER 13 * 04900016 * WORKAREA- OBTAINED BY GETMAIN, ADDRESS SAVED IN REGISTER 5 * 04950016 * NEW TIOT- OBTAINED BY GETMAIN, HOLDS ENTRY FROM DSC * 05000016 * INPUT BUFFER- OBTAINED BY GETMAIN, SIZE IS BLKSIZE OF SYSOUT DCB. * 05050016 * SMF WORKAREA - OBTAINED BY GETMAIN, HOLDS TYPE 6 SMF RECORD 19018 05070019 * * 05100016 *ATTRIBUTES- * 05150016 * * 05200016 * REENTRANT * 05250016 * * 05300016 *NOTES- * 05350016 * * 05400016 * THE OPERATION OF THIS SUBROUTINE DEPENDS UPON AN INTERNAL * 05450016 * REPRESENTATION OF THE EXTERNAL CHARACTER SET WHICH IS EQUIVALENT * 05500016 * TO THE ONE USED AT ASSEMBLY TIME. THE CODING HAS BEEN ARRANGED * 05550016 * SO THAT REDEFINITION OF THE CHARACTER CONSTANTS, BY REASSEMBLY, * 05600016 * WILL RESULT IN A CORRECT SUBROUTINE FOR THE NEW DEFINITIONS. * 05650016 EJECT 000A 05700016 *********************************************************************** 05750016 * 05800016 * REGISTER ASSIGNMENTS 05850016 * 05900016 *********************************************************************** 05950016 * 06000016 R15 EQU 15 SUBROUTINES ENTRY 06050016 * 06100016 R14 EQU 14 SUBROUTINES EXIT 06150016 * 06200016 R13 EQU 13 SAVE AREA FOR THIS LINE 06250016 * 06300016 R12 EQU 12 PROGRAM BASE 06350016 * 06400016 R11 EQU 11 ADDR OF INPUT BUFFER 000A 06450016 * 000A 06500016 R10 EQU 10 BASE OF AVT DSECT 06550016 * 06600016 R9 EQU 9 HOLDS ADDR OF NON-RESIDENT 000A 06650016 * ROUTINE, IHKCDMDQ 000A 06700016 R8 EQU 8 TEMPORARY STORAGE 06750016 * (DISC DCB ADDR) 06800016 R7 EQU 7 TEMPORARY STORAGE 06850016 * (OLD TIOT ADDR) 06900016 R6 EQU 6 ADDR OF QEB AS GIVEN BY 06950016 * IHKCCQMG 07000016 R5 EQU 5 ADDR OF GETMAIN WORKAREA 07050016 * 07100016 R4 EQU 4 RETURN ADDR FROM INTERNAL 07150016 * ROUTINES 07200016 R3 EQU 3 ADDR OF TERMINAL DIRECTORY 07250016 * ENTRY 07300016 R2 EQU 2 ADDR OF LCB (LINE CONTROL 07350016 * BLOCK) 07400016 R1 EQU 1 ADDR OF PARAMETER LIST FOR 07450016 * SUBROUTINES 07500016 R0 EQU 0 07550016 EJECT 000A 07600016 USING IHKABLWR,R12 PROGRAM BASE 000A 07650016 * 000A 07700016 USING IHKZZAVT,R10 BASE OF AVT DSECT 07750016 * 07800016 USING LWRUCB,R14 BASE OF UCB DSECT 07850016 * 07900016 USING LWKWORK,R5 BASE OF WORKAREA DSECT 07950016 * 08000016 USING TDIREC,R3 BASE OF TERMINAL DIRECTORY 08050016 * DSECT 08100016 USING LCBDSECT,R2 BASE OF LINE CONTROL BLOCK 08150016 * DSECT 08200016 USING LWRTCB,R15 BASE OF TCB DSECT 08250016 * 08300016 * USING LWRCVT,R1 TEMPORARY BASE OF CVT DSECT 08350016 * SEE SECTION 'DSB HANDLER' 08400016 * USING IECTDECB,R1 TEMPORARY BASE OF DECB - SEE 08450016 * SECTION 'DSB HANDLER' 08500016 * USING FASTAB,R1 TEMPORARY BASE OF FASTABLE (SEE 08550016 * WRITE ERROR JED, 08600016 * READ ERROR JED, 08650016 * CALL Q MANAGER DELETE) 08700016 * USING IECTDECB,R8 TEMPORARY BASE OF DECB (SEE 08750016 * SECTION 'DSB HANDLER') 08800016 * 08850016 * USING IHADCB,R8 TEMPORARY BASE OF DISC DCB (SEE 08900016 * SECTION 'DSB HANDLER') 08950016 EJECT 000A 09000016 *********************************************************************** 09050016 * 09100016 * ENTRY - LINE ANALYSIS WRITE 09150016 * 09200016 *********************************************************************** 09250016 * 09300016 B 14(0,R15) BRANCH AROUND ID 000A 09350016 DC AL1(8) ID LENGTH 000A 09400016 DC CL8'IHKABLWR' IDENTIFIER 000A 09450016 LR R12,R15 SET PROGRAM BASE 000A 09500016 * PRESET REGISTERS 09550016 L R2,0(R1) GET LCB ADDRESS 09600016 L R3,LCBTDIR GET ADDR OF TERMINAL 09650016 * DIRECTORY ENTRY 09700016 LPR R8,R12 SET EXIT FLAG TO ABNORMAL 09750016 L R10,LWRADCOM SET BASE OF AVT DSECT 09800016 * 09850016 LA R0,LWRSIZE GET SIZE OF GETMAIN WORKAREA 09900016 BAL R4,LWRGETMA GO GET CORE FOR WORKAREA 09950016 * 10000016 * WAS GETMAIN SUCCESSFUL 10050016 BZ LWRGETOK YES, BRANCH - NO, CONTINUE 10100016 * 10150016 WTO 'IHK061I OUT OF SPACE EMITTER WORKAREA', 000C*10180018 ROUTCDE=(2),DESC=(4) 000C 10210018 * 10250016 B LWRFINI QUIT 10300016 * 10350016 LWRGETOK DS 0H 10400016 L R5,LWRWORD GET ADDRESS OF GETMAIN WORKAREA 10450016 XC 0(255,R5),0(R5) CLEAR GETMAIN WORKAREA 10500016 XC 255(245,R5),255(R5) TO ZEROS 10550016 XC 500(LWRSIZE-500,R5),500(R5) 10600016 MVC LWKADCBS(4),IHKZZCBS PASS A(IHKCDCBS) TO WORKAREA 10650016 MVC LWKADISP(4),IHKZZDSP PASS A(IHKAADSP) TO WORKAREA 10700016 MVI LWRBLDM,LWRX80 10750016 ST R5,LCBWORKA SAVE WORKAREA ADDR IN LCB 10800016 * 10850016 * TDIRSTAT BIT 5 - DEQUEUE NOTHING SWITCH 10900016 * 10950016 * '1' - NO OUTPUT CAN BE DEQUEUED 11000016 * '0' - OUTPUT MAY BE DEQUEUED 11050016 TM TDIRSTAT,TDIRDQNN 11100016 BO LWREXIT EXIT IF NOTHING CAN BE DEQUEUED 11150016 * 11200016 TM TDIRSWCH+1,TDIRDISN TEST TO DISCONTINUE 11250016 BO LWRCONOK IF SO, TRY TO CONTINUE 11300016 * IF NOT, HAS CONTENTION 11350016 TM TDIRSWCH+2,TDIRCDSN DISCONTINUE BEEN SET 11400016 BZ LWRANYQB IF NOT, GO GET QEB CHAIN 11450016 * TRY RECOVER FROM CONTENTION 11500016 NI TDIRSWCH+2,TDIRCDSF TURN OFF CONTENTION DISCONTINUE 11550016 OI TDIRSWCH+1,TDIRCNTN TURN ON CONTINUE 'HERE' 11600016 B LWRKON PROCESS CONTINUE 11650016 * 11700016 LWRCONOK DS 0H 11750016 * IF SO, 11800016 TM TDIRSWCH+1,TDIRCNTN HAS SERVICE BEEN CONTINUED 11850016 BC 8,LWRBADCN BRANCH IF NO CONTINUE HAS BEEN 11900016 * RECEIVED 11950016 * 12000016 * CONTINUE 12050016 * 12100016 * DEFINITION--TDIRSWCH BITS 9-10, CONTINUE SWITCHES 12150016 * 12200016 * '00' - A CONTINUE COMMAND HAS NOT BEEN RECEIVED 12250016 * '01' - CONTINUE AT THE BEGINNING 12300016 * '10' - THROW AWAY DISCONTINUED DATA 12350016 * '11' - CONTINUE FROM POINT WHERE DISCONTINUE STOPPED 12400016 * 12450016 LWRKON DS 0H 12500016 MVC LWKDTTR,TDIRDTTR SET TTR TO BEGINNING BLOCK 12550016 * 12650016 L R6,TDIRFAST GET ADDR OF DISCONTINUED QEB 12700016 ST R6,LWKSAVE6 TO R6 AND WORKAREA 12750016 NI TDIRSWCH+1,TDIRDISF TURN OFF DISCONTINUE A55909 12752021 BAL R4,LWRITE0 START OR END OF DATA SET A50147 12755021 LTR R6,R6 DO WE HAVE A POINTER A32852 12760020 BZ LWRANYQB IF NOT GET ONE FROM QEB CHAIN A32852 12770020 TM 0(R6),LWRQEBMS TEST IF MSG QEB A32852 12850020 BO LWRMSGCN BRANCH IF MSG WAS DISCONTINUEDA32852 12900020 * PROCEED IF JOB 12950016 LA R0,JEDTNMSG PASS ADDR OF CORE JED 13000016 BAL R14,LWRCALJD READ JED TO CORE 000A 13050016 * 13100016 SH R15,LWRFOUR CHECK RETURN CODE 13150016 BZ LWRJEDRE BRANCH IF READ ERROR 13200016 * PROCEED IF GOOD READ 13250016 BAL R4,LWREADSB READ DISCONTINUED DSB/SMB 13300016 * 13350016 MVC LWKSYSCT(24),JEDTNMSG RESTORE WORKAREA HEADER 19018 13400019 CLI SMBMSGLN,LWRDSBFF IS IT A DSB 13450016 BC 8,LWRDSB YES, NOW CHECK TYPE OF CONTINUE 13500016 * 000A 13550016 CLI SMBMSGLN,LWRDSB00 IS IT A SCRATCHED DSB 13600016 BC 7,LWRSMB NO, IT MUST BE AN SMB 13650016 * 000A 13700016 B LWRBUMP YES, BUMP SYSOUT CLASS PTR, GO 13750016 * TO NEXT DSB/SMB. 13800016 LWRDSB TM TDIRSWCH+1,TDIRCN2N CHECK TYPE OF CONTINUE 13850016 BZ LWRNO NO, THROW AWAY THIS DSB 13900016 * CONTINUE IF 'HERE' OR 'BEGIN' 13950016 TM TDIRSWCH+1,TDIRCN1N WHICH IS IT, 'HERE' OR 'BEGIN' 14000016 BO LWRFFTST HERE 14050016 * 000A 14100016 * BEGIN 14150016 XC TDIRDTTR,TDIRDTTR CLEAR TTR OF HERE 14200016 MVC LWKDTTR,LWRTTR SET TTR TO FIRST BLOCK 14250016 B LWRFFTST GO PROCESS DSB OR SMB 14300016 * 14350016 * NO 14400016 LWRNO IC R1,LWKSYSCT BUMP SYSOUT CLASS POINTER 14450016 LA R1,1(R1) PAST SKIPPED SYSOUT CLASS 14500016 STC R1,LWKSYSCT 14550016 B LWREND GO SCRATCH SYSOUT DATA SET 14600016 * 14650016 LWRBADCN DS 0H NO CONTNUE RECEIVED YET 14700016 * 14750016 LWRPREXT LPR R8,R12 SET FLAG TO EXIT EVEN THOUGH 14800016 B LWRPREXX TDIRFQEB MAY NOT BE ZERO 14850016 EJECT 14900016 * GET QEB, IF ANY 14950016 * 15000016 LWRANYQB XC TDIRFAST(8),TDIRFAST CLEAR QEB AND TTR POINTER 15050016 CLC TDIRFQEB+1(3),LWRFZERO ARE ANY QEB'S ON OUTPUT QUEUE 15100016 BC 7,LWRSKIP YES. PROCESS QEB 15150016 * 15200016 * NO QEB TO BE PROCESSED 15250016 * PREPARE TO EXIT 15300016 SR R8,R8 SET FLAG TO EXIT BECAUSE 15350016 * TDIRFQEB IS ZERO 15400016 LWRPREXX DS 0H 15450016 BAL R4,LWRITE0 START OR END OF DATA SET 15500016 * 15550016 TM TDIRSTAT,TDIRNQMN TEST 'ENQ MSG' BIT 15600016 * IF '0'-TERMINAL HAS RJENDED 15650016 BO LWRENQON IF '1'-NOT RJENDED 15700016 * 15750016 TM TDIRSWCH,TDIRRJSN HAS RJSTART CARD BEEN RECEIVED 15800016 BO LWRENQON YES, PREVIOUS RJEND INDICATOR 15850016 * IS INVALID 15900016 * NO, TERMINAL IS RJENDED 15950016 TM TDIRSWCH+2,TDIRMCHN '1'-CPU. '0'-2780 16000016 BZ LWREOT FOR 2780, FORGET SOH 5 16050016 * 000A 16100016 LNR R7,R12 REQUEST SOH 5 TO BE SENT TO 16150016 BAL R4,LWRITE REMOTE TO INDICATE RJEND 16200016 * 16250016 B LWRTSW GO TEST FOR SWITCHED LINE 16300016 * 16350016 LWREOT DS 0H 16400016 * EOT THE LINE 16450016 TM TDIRSTAT,TDIRNQMN IS 'ENQ MSG' BIT ON 16500016 BO LWRENQON YES, SKIP 16550016 * NO, CONTINUE 16600016 CLC TDIRFQEB+1(3),LWRFZERO IS TERMINAL QUEUE EMPTY 16650016 BNE LWRENQON NO, SKIP 16700016 * YES, CONTINUE 16750016 LWRTSW DS 0H 16800016 CLI LCBTYPLN,LCBSWTCH IS LINE SWITCHED 16850016 BNE LWREOTLN NO, SKIP 16900016 * YES, CONTINUE 16950016 * 17000016 * RJEND HAS BEEN RECEIVED, THE MESSAGE HAS BEEN SENT, NOW HANG UP. 17050016 * 17100016 L R1,LCBLDECB GET ADDR OF LINE DECB 17150016 * 000A 17200016 WRITE (1),TD,MF=E EOT AND HANG UP (DISABLE) 17250016 * 17300016 OI TDIRSWCH+1,TDIRDABN SET DISABLED SWITCH 'ON' 17350016 B LWRWAIT 17400016 * 17450016 LWRENQON CLI LCBTYPLN,LCBSWTCH IS LINE SWITCHED 17500016 BE LWRDOABT 17550016 * 17600016 LWREOTLN DS 0H 17650016 TM TDIRSWCH+1,TDIRWRTN HAS LINE BEEN USED YET 17700016 BZ LWRFIXUP GO FIX UP 1657 17750018 * YES, DO EOT AND THEN EXIT 17800016 L R1,LCBLDECB GET ADDR OF LINE DECB 17850016 * 000A 17900016 WRITE (1),TN,MF=E EOT THE LINE 17950016 * 18000016 LWRWAIT L R15,IHKZZDSP 18050016 BALR R14,R15 WAIT IN DISPATCHER FOR I/O 18100016 * 18150016 LWRFIXUP DS 0H 1657 18155018 TM TDIRSTAT,TDIRNQMN IF ENQUEUE MSGS IS ON, 1657 18160018 BO LWREXIT SKIP FIX UP 1657 18165018 L R15,IHKZZRCS GET COMM EWITCH SDDR 1657 18170018 TM 0(R15),LWRX80 IS CENTRAL IN STOP CONDITIO1657 18175018 BO LWREXIT SKOP FIX-UP 1657 18180018 TM TDIRSWCH+1,TDIRDABN IS DISABLE SWITCH ON ? A48402 18181021 BO LWREXIT YES - SKIP FIX UP A48402 18182021 XC LCBTDIR,LCBTDIR ZIP TDIR POINTER 1657 18185018 XC TDIRLCB,TDIRLCB ZIP LCB POINTER 1657 18190018 B LWREXIT 18200016 * END OF EOT ROUTINE 18250016 * 18300016 LWRDOABT LNR R8,R12 INDICATE EXIT TO ABEOT 18350016 LWREXIT DS 0H 18400016 LA R0,LWRSIZE GET SIZE OF GETMAIN WORKAREA 18450016 LR R1,R5 18500016 * 18550016 FREEMAIN R,LV=(0),A=(1) RETURN WORKAREA CORE 18600016 * 18650016 LWRFINI DS 0H 18700016 LTR R8,R8 WHY IS LWR EXITING 18750016 BZ LWRLST BRANCH IF TDIRFQEB IS ZERO 18800016 * 000A 18850016 BM LWRABEOT EXIT IS ABEOT 18900016 * 18950016 LA R15,LWR4 SET RETURN CODE TO IHKABREQ 19000016 B LWRSKIP1 19050016 * 000A 19100016 LWRABEOT DS 0H 19150016 LA R15,LWR8 SET RETURN CODE TO IHKABEOT 19200016 B LWRSKIP1 EXIT 19250016 * 000A 19300016 LWRLST DS 0H 19350016 SR R15,R15 SET RETURN CODE TO IHKABLST 19400016 LWRSKIP1 DS 0H 19450016 NI TDIRSWCH+1,TDIRWRTF RESET TO WRITE INITIAL 19500016 L R14,IHKZZLSC GET ADDR OF LINE SCHEDULER 19550016 BR R14 EXIT 19600016 * 000A 19650016 * 19700016 LWRSKIP L R6,TDIRFQEB PUT QEB ADDR IN R6 19750016 ST R6,LWKSAVE6 SAVE QEB ADDR 19800016 * 19850016 * WHAT KIND OF QEB - MSG OR JOB 19900016 * 19950016 TM 0(R6),LWRQEBMS FIRST BIT OF QEB 20000016 * '1'-MESSAGE 20050016 * '0'-JOB 20100016 BC 1,LWRMSG GO PROCESS MSG QEB 20150016 * CONTINUE IF JOB QEB 20200016 EJECT 20250016 * JOB QEB FOUND 20300016 * 20350016 TM TDIRSTAT,TDIRDQMN TEST 'DEQ MSG ONLY' 20400016 BC 1,LWRPREXT RJEND FORBIDS JOB OUTPUT,EXIT 20450016 * 000A 20500016 BAL R14,LWRDEQEB DEQUEUE JOB QEB 000A 20550016 * 20600016 TIME BIN GET TIME AND DATE 19018 20610019 STM R0,R1,LWKTIME SAVE TIME AND DATE 19018 20620019 BAL R4,LWRITE0 START OR END OF DATA SET 20650016 * 20700016 XC TDIRFAST(8),TDIRFAST CLEAR CONTINUE INFORMATION 20800016 ST R6,TDIRFAST STORE JOB QEB A32841 20820020 MVC LWKDTTR,LWRTTR SET TTR TO FIRST BLOCK 20850016 MVI LWKSYSCT,LWRONE PRESET POINTER TO SYSOUT CLASS 20900016 LA R0,JEDTNMSG GET ADDR OF CORE JED AREA 20950016 * MODIFIED TO HALFWORD BOUNDARY 21000016 BAL R14,LWRCALJD READ JED TO CORE 000A 21050016 * 21100016 SH R15,LWRFOUR IF RETURN CODE IS 4, 21150016 BZ LWRJEDRE GO TO JED READ ERROR ROUTINE 21200016 * IF NOT 4,GOOD READ--CONTINUE 21250016 * 21300016 XC LWKCOUNT(6),LWKCOUNT START WITH ZERO FIELDS 19018 21320019 LWRNXTTR CLC JEDTTTR0(3),LWRFZERO IS THERE A DSB/SMB TO BE READ 21350016 BC 8,LWRNODSB END OF JOB OUTPUT. GO DELETE 21400016 * CHAIN OF SMB/DSB 21450016 BAL R4,LWREADSB CALL OS Q MANAGER TO READ 21500016 * 21550016 CLI SMBMSGLN,LWRDSB00 WAS THIS A DSB WHOSE DATA 21600016 * HAS BEEN SCRATCHED 21650016 BC 7,LWRFFTST NO, TEST FOR DSB/SMB 21700016 * 21750016 CLI SMBIDENT,LWRDSB15 IS THIS REALLY A DSB A22275 21760018 BNE LWRNX NO ITS A BLANK SMB A22275 21770018 LWRBUMP DS 0H 21800016 SR R1,R1 YES, SKIP THIS EMPTY DSB 21850016 IC R1,LWKSYSCT GET SYSOUT CLASS POINTER 21900016 LA R1,1(R1) BUMP TO NEXT SYSOUT CLASS 21950016 STC R1,LWKSYSCT SAVE UPDATED COUNTER 22000016 * 22050016 LWRNX MVC SMBDSKAD(3),SMBNEXT UPDATE NEXT TTR IN QMPA 22100016 MVC LWKDTTR,LWRTTR SET TTR TO FIRST BLOCK 22150016 B LWRNXTTR GO TRY NEXT DSB/SMB 22200016 * 22250016 LWRFFTST CLI SMBMSGLN,LWRDSBFF IS IT DSB OR SMB 22300016 BC 7,LWRSMB BRANCH IF IT IS SMB, 22350016 * CONTINUE IF IT IS DSB 22400016 EJECT 22450016 * DSB HANDLER 22500016 * 22550016 * CHECK FOR CHANGE OF FORMS ON PRINTER 22600016 * 22650016 SR R1,R1 22700016 IC R1,TIOELNGH GET LENGTH OF TIOT ENTRY IN DSB 22750016 LA R15,TIOELNGH GET ADDR OF TIOT ENTRY 22800016 LA R15,4(R15,R1) GET ADDR OF 4 CHAR FORM ID 22850016 CLC TDIRFORM(4),0(R15) ARE FORMS TO BE CHANGED 22900016 BE LWRFORMG NO, KEEP SAME FORMS 22950016 * YES, REQUEST NEW FORMS 23000016 BAL R9,LWRSMF WRITE SMF RECORD 19018 23020019 MVC TDIRFORM(4),0(R15) RECORD NEW FORM ID IN TERMINAL 23050016 * DIRECTORY - IN CORE 23100016 LR R1,R3 23150016 L R15,IHKZZTMR AND 23200016 BALR R14,R15 DISC 23250016 * 23300016 BAL R4,LWRITE0 START OR END OF DATA SET 23350016 * 23400016 MVC LWRBRTIT(4),TDIRFORM PUT FORM ID TO MESSAGE 23450016 MVI LWRMSOFS+1,LWROFS71 OFFSET OF FORM CHANGE MSG 23500016 MVI LWRMSLEN,LWR4 MESSAGE LENGTH OF 4 23550016 BAL R4,LWRCBLD GET MESSAGE 23600016 * 23650016 BAL R4,LWRITER1 SEND MSG TO REMOTE 000A 23700016 * 23750016 BAL R4,LWRITE0 END OF MSG 23800016 MVC TDIRDTTR(4),LWKDTTR SAVE INITIAL TTR FOR CONTINUE 23850016 * 23900016 LA R1,LWR4 INDICATE FORM CHANGE 23950016 ST R1,LCBPARM1 TO DISCONTINUE ROUTINE 24000016 B IHKABLW1 GO TO DISCONTINUE 24050016 * 24100016 LWRFORMG DS 0H 24150016 L R8,LCBDDECB GET ADDR OF DISC DECB 24200016 USING IECTDECB,R8 ESTABLISH DSECT BASE FOR DECB 24250016 L R8,DECDCBAD GET ADDR OF DISC DCB 24300016 DROP R8 24350016 USING IHADCB,R8 NOW USE R8 AS BASE OF DCB DSECT 24400016 * RATHER THAN OF DISC DECB 24450016 MVC 0(88,R8),LWRDDCB MOVE SAMPLE DCB TO DISC DCB 24500016 * WORKAREA, DEFINED IN R8 24550016 MVC DCBDDNAM(8),TIOEDDNM MOVE DDNAME FROM DSB TO DCB 24600016 LA R1,LWRLIST 24650016 ST R1,DCBEXLST PREPARE EXLST FOR IHKABRER 24700016 MVI LWRLIST,LWRLST87 24750016 * 24800016 * 24850016 USING LWRCVT,R1 24900016 LA R1,CVTPTR GET ADDR OF CVT PTR 24950016 L R1,0(R1) GET ADDR OF PTR TO TCB PTR 25000016 L R1,CVTTCBP GET ADDR OF TCB PTR 25050016 L R15,4(R1) GET ADDR OF TCB 25100016 ST R15,LWKADTCB SAVE ADDR OF TCB IN LWK 25150016 L R1,TCBTIO GET ADDR OF TIOT 25200016 ST R1,LWKTIOTO SAVE ADDR OF OLD TIOT 25250016 DROP R1 25300016 * 25350016 SR R11,R11 25400016 IC R11,TIOELNGH GET LENGTH OF NEW TIOT ENTRY 25450016 * WHICH IS IN DSB 25500016 LA R0,28(R11) ADD TO SIZE OF NEW TIOT ENTRY 25550016 * THE SIZE OF THE HEADER OF THE 25600016 * OLD TIOT, PLUS 4 FOR A ZERO 25650016 * END SENTINEL WORD. (24+4) 25700016 ST R0,LWKTIOTL SAVE LENGTH OF NEW TIOT FOR 25750016 * LATER USE BY FREEMAIN 25800016 BAL R4,LWRGETMA GO GET CORE FOR NEW TIOT 25850016 * 25900016 BZ LWRGTOK BRANCH IF GETMAIN SUCCESSFUL 25950016 * CONTINUE IF CORE NOT AVAILABLE 26000016 BAL R6,LWRERGM SEND MSG TO CENTRAL AND REMOTE 26050016 * ABOUT NO CORE AVAILABLE 26100016 L R6,LWKSAVE6 RESTORE QEB POINTER 26150016 B LWREND PRETEND END OF FILE WAS READ 26200016 * 26250016 LWRGTOK DS 0H 26300016 L R1,LWRWORD GET ADDRESS OF NEW CORE AREA 26350016 ST R1,LWKTIOTN SAVE ADDR OF NEW TIOT 26400016 L R15,LWKTIOTL GET LENGTH OF GETMAIN AREA 26450016 BCTR R15,R0 ADJUST LENGTH FOR 'EX' INSTR. 26500016 EX R15,LWRXC CLEAR GETMAIN NEW TIOT AREA TO 26550016 * ZERO. ALL BUT LAST WORD (END 26600016 * SENTINEL) WILL BE OVERLAYED 26650016 * BY HEADER FROM OLD TIOT AND 26700016 * SYSOUT DATA SET ENTRY FROM 26750016 * DSB. 26800016 L R7,LWKTIOTO GET ADDR OF OLD TIOT 26850016 MVC 0(24,R1),0(R7) MOVE HEADER (FIRST 24 BYTES) OF 26900016 * OLD TIOT TO NEW TIOT 26950016 BCTR R11,R0 GET LENGTH OF NEW TIOT ENTRY IN 27000016 * DSB ADJUSTED FOR 'EX' INSTR. 27050016 EX R11,LWRMVTIO MOVE TIOT FOR SYSOUT DATA 27100016 * SET FROM DSB TO NEW TIOT 27150016 BAL R4,LWRNTIO CHANGE TIOT PTR IN TCB TO NEW 27200016 * TIOT TEMPORARILY 27250016 ST R8,LWRADDCB PASS ADDR OF SYSOUT DCB 27450016 ST R3,LWRADTDE PASS ADR OF TDE TO RER A32869 27470021 L R1,LWKTIOTN GET NEW TIOT ADDRESS A47442 27500021 ST R1,LWRNTIOT PASS ADDRESS OF TIOT A47442 27520021 TM SMBMSGLN+1,LWRX80 WAS USER CNT INCR BY WMS? A47442 27540021 BZ LWROPE NO, GO LWROPE; YES, PASS A47442 27560021 OI LWRNTIOT,LWRX80 TO ABRER VIA NEW TIOT PTR A47442 27580021 LWROPE LA R1,LWRNTIOT PASS ADDR OF PARAM.LIST A47442 27600021 * 27650016 LINK EPLOC=LWRADRER TRY TO OPEN SYSOUT DATA SET000A*27700016 IF NOT EMPTY OR MISSING 000A 27750016 * 27800016 LTR R15,R15 TEST FOR VOLID NOT A47442 27850021 * FOUND A47442 27857021 BZ VOLFOUND VOLID FOUND PROCEED A47442 27864021 MVI LWKADDSB,X'FF' INDICATE VOL NOT FOUND A47442 27871021 MVC LWRBRTIT(6),0(R15) MOVE VOLID A47442 27878021 * FOR LATER PROCESSING A47442 27885021 VOLFOUND BAL R4,LWROTIO PUT OLD TIOT PTR INTO TCB A47442 27892021 * 27900016 TM DCBOFLGS,LWRDCBOP IS SYSOUT DATA SET OPEN 27950016 BZ LWRNOOP2 NO, ERROR 28000016 OI LCBWORKA,DATAOPEN SET INDICATOR FOR OPEN DATA SETA28929 28020020 * 28050016 BAL R4,LWRITE0 START OR END OF DATA SET 28100016 * 28150016 BAL R4,LWRHEAD SET UP PARAMETERS IN HEADING 28200016 * 28250016 LTR R15,R15 CHECK RETURN CODE 28300016 BNZ LWREODA1 BAD, CLOSE DATA SET 28350016 * 28400016 LWRGTBUF LH R0,DCBBLKSI GET MAXIMUM SIZE OF BLOCK 28450016 BAL R4,LWRGETMA GO GETMAIN FOR INPUT BUFFER 28500016 * 28550016 * CHECK GETMAIN FOR INPUT BUFFER 28600016 BZ LWRGTO BRANCH IF GETMAIN SUCCESSFUL 28650016 * CONTINUE IF CORE NOT AVAILABLE 28700016 XC LWKSTABF(4),LWKSTABF ZERO OUTPUT BUFFER ADDR A28219 28730019 OI TDIRRB,X'40' SET NO CORE SWITCH A28219 28760019 BAL R6,LWRERGM SEND MSG TO CENTRAL AND REMOTE 28790019 NI TDIRRB,X'BF' TURN OFF NO CORE BIT A37798 28820020 L R6,LWKSAVE6 RESTORE QEB POINTER 28850016 B LWREODA1 GO CLOSE SYSOUT DATA AND FREE 28900016 * CORE FOR TIOT - PRETEND 28950016 * END OF FILE WAS READ 29000016 * 29050016 LWRNOOP2 DS 0H A47442 29100021 CLI LWKADDSB,X'FF' WAS VOLID FOUND ? A47442 29108021 BNE LWRINCSY VOLID FOUND PROCEED A47442 29116021 BAL R9,LWRNOVO2 NOT FOUND, ISSUE MSG A47442 29124021 LWRINCSY SR R15,R15 A47442 29132021 IC R15,LWKSYSCT GET SYSOUT CLASS POINTER A47442 29140021 LA R15,1(R15) BUMP POINTER PAST UNUSED CLASS 29150016 STC R15,LWKSYSCT RESTORE BUMPED POINTER 29200016 B LWRBDOPE SCRATCH NEW TIOT 29250016 * 29300016 LWRGTO DS 0H 29350016 LA R11,LWKDTTR GET TTR 29400016 * 29450016 POINT (8),(11) SELECT STARTING BLOCK 29500016 * 29550016 L R11,LWRWORD SAVE BUFFER ADDRESS 29600016 ST R11,LWKSTABF SAVE ADDR OF BUFFER 29650016 * 29700016 LWRBUFOK L R1,LCBDDECB GET DISC DECB ADDR 29750016 L R11,LWKSTABF GET BUFFER ADDRESS 29800016 * 29850016 READ (1),SF,(8),(11),'S',MF=E 29900016 * 29950016 L R15,IHKZZDSP 30000016 BALR R14,R15 CALL DISPATCHER AND WAIT 30050016 * 30100016 LA R1,0(R1) CLEAR HIGH BYTE FOR ERROR 30150016 * HANDLING IN CHECK 30200016 BAL R4,LWRNTIO GET NEW TIOT ADDR INTO TCB 30250016 * 30300016 * 30350016 LR R4,R1 SAVE REG. 1 A22262 30370018 CHECK (1) 30400016 * 30450016 LR R1,R4 RESTORE REG. 1 A22262 30470018 BAL R4,LWROTIO RESTORE OLD TIOT PTR INTO TCB 30500016 * 30550016 * 30600016 USING IECTDECB,R1 30650016 L R15,DECSENS0 GET ADDRESS OF STATUS INDICATOR 30700016 DROP R1 30750016 LH R7,DCBBLKSI GET SIZE OF MAXIMUM BLOCK 30800016 SH R7,LWRESID(R15) SUBTRACT RESIDUAL BLOCK TO FIND 30850016 * HOW MANY BYTES WERE READ 30900016 LR R15,R11 GET BUFFER ADDRESS 30950016 AR R15,R7 ADD NO. BYTES READ TO BUFF ADDR 31000016 ST R15,LWKENDBF SAVE ADDR OF 1ST BYTE BEYOND 31050016 * BUFFER 31100016 NOTE (8) SAVE TTR OF BLOCK JUST READ 31150016 * 31200016 ST R1,LWKTTR 31250016 * 31300016 CLI LWKID,LWKUSEXH IS USER EXIT THE DESTINATION 31350016 BE LWRASIS YES, SEND ENTIRE BLOCK 31400016 * 31450016 CLI LWKRECFM,LWKFXUBH IS FORMAT FIXED UNBLOCKED 31500016 BE LWRFB CALL XMIT ROUTINE 31550016 * 31600016 CLI LWKRECFM,LWKFXBLH IS FORMAT FIXED BLOCKED 31650016 BE LWRFB GO DEBLOCK 'FB' RECORD 31700016 * 31750016 CLI LWKRECFM,LWKVAUBH IS FORMAT VARIABLE UNBLOCKED 31800016 BE LWRVUB GO SET UP VAR. RECORD 31850016 * 31900016 CLI LWKRECFM,LWKVARBH IS FORMAT VARIABLE BLOCKED 31950016 BE LWRVB GO DEBLOCK VARIABLE RECORD 32000016 * 32050016 * RECFM IS UNDEFINED 32100016 * SEND IT AS IS 32150016 * 32200016 LWRASIS BAL R4,LWRITE1 XMIT DATA 19018 32250019 * 32300016 B LWRBUFOK GO GET NEXT RECORD 32350016 * 32400016 LWRFB DS 0H LOGICAL RECORDS ARE FIXED, 32450016 * BLOCKS ARE BLOCKED OR UNBLKED 32500016 LH R7,DCBLRECL 32550016 LWKMORE BAL R4,LWRITE1 XMIT LOGICAL RECORD 19018 32600019 * 32650016 AR R11,R7 BUMP PTR TO NEXT RECORD, IF ANY 32700016 C R11,LWKENDBF IS THIS THE END OF THE BLOCK 32750016 BL LWKMORE GO SEND NEXT RECORD 32800016 * 32850016 B LWRBUFOK GO READ NEXT BLOCK 32900016 * 32950016 LWRVUB DS 0H 33000016 LWRVB LR R15,R11 GET ADDR OF BUFFER 33050016 MVC LWKH,0(R11) 33100016 AH R15,LWKH ADD TOTAL BUFFER SIZE 33150016 ST R15,LWKENDBF SAVE UPPER LIMIT OF BUFFER 33200016 LA R11,4(R11) POINT TO FIRST LOGICAL RECORD 33250016 LWRVBMOR MVC LWKH,0(R11) 33300016 LH R7,LWKH GET LOGICAL RECORD LENGTH 33350016 LA R11,4(R11) POINT TO DATA 33400016 SH R7,LWRFOUR ADJUST TO LENGTH OF DATA ONLY 33450016 BAL R4,LWRITE1 XMIT DATA 19018 33500019 * 33550016 SH R11,LWRFOUR RETURN TO LOGICAL REC LENGTH 33600016 MVC LWKH,0(R11) 33650016 AH R11,LWKH POINT TO NEXT LOGICAL RECORD 33700016 C R11,LWKENDBF IS BUFFER EMPTY 33750016 BL LWRVBMOR NO, GO GET NEXT LOGICAL REC 33800016 * 000A 33850016 B LWRBUFOK YES, GO READ NEXT BLOCK 33900016 EJECT 33950016 * DISC ERROR ON SYSOUT 34000016 * 34050016 LWRSYNAD DS 0H 34100016 OI LWKSTATS,LWKIOERR INDICATE ERROR TO SMF 19018 34120019 BAL R4,LWROTIO RESTORE OLD TIOT PTR INTO TCB 34150016 * 34200016 BAL R4,LWRITE0 NEW DATA SET 34250016 * 34300016 MVC LWRWORD+1(3),TIOEFSRT GET UCB ADDRESS 34350016 L R14,LWRWORD TO UCB BASE REG 34400016 * 34450016 MVC LWRBRTIT(6),SRTEVOLI 6 CHAR VOL SERIAL NO. 34500016 MVI LWRBRTIT+6,LWRBLANK 34550016 MVC LWRBRTIT+7(8),LWRQMNAM JOBNAME 34600016 MVI LWRBRTIT+15,LWRBLANK 34650016 MVC LWRBRTIT+16(8),TIOEDDNM DDNAME 34700016 MVI LWRMSOFS+1,LWROFS68 DISC ERROR VOLUME JOBNAME DDN 34750016 MVI LWRMSLEN,LWR24 34800016 * 34850016 BAL R4,LWRCBLD CALL BUILDMSG 34900016 * 34950016 BAL R4,LWRITE35 SEND ERROR MSG TO CENTRAL 000A 35000016 * AND REMOTE 000A 35050016 * 35100016 * ASSUME EOF WAS READ 35150016 * 35200016 * WHEN END OF FILE IS READ 35250016 * FROM SYSIN DATA SET 35300016 * 35350016 LWREODAD DS 0H DEFINE TAG 000C 35370018 BAL R4,LWROTIO RESTORE OLD TIOT POINTER 000C 35390018 BAL R4,LWRITE0 START OR END OF DATA SET 000C 35410018 BAL R4,LWRXDAD FREE CORE FOR BUFFER 000C 35430018 * 35450016 LWREODA1 BAL R4,LWRXDA1 CLOSE SYSOUT DATA SET 35500016 * 35550016 LWRBDOPE BAL R4,LWRXDOPE FREE CORE OF NEW TIOT 35600016 * 35650016 LWREND DS 0H 35700016 BAL R4,LWRITE0 START OR END OF DATA SET 35750016 * 35800016 CLI LWKADDSB,X'FF' VOLUME FOUND A47442 35810021 BE LWRNOSCR NO, DON'T SCRATCH A47442 35820021 LA R1,JEDTTTR0 GET ADDR OF DSB 35850016 ST R1,LWKADDSB PASS DSB ADDR TO PARAM LIST 35900016 LA R1,JEDTQMPA GET ADDR OF QMPA 35950016 ST R1,LWKADQMP PASS ADDR OF QMPA TO PARAM LIST 36000016 * 36050016 LOAD EPLOC=LWRADRMV 36100016 * 36150016 LA R1,LWKADDSB PASS ADDR OF PARAMETER LIST 36200016 LR R15,R0 CALL ROUTINE TO DELETE THE 36250016 BALR R14,R15 SYSOUT DATA SET 36300016 S R15,LWRTEN A47442 36307021 LTR R15,R15 TEST FOR VOLID FOUND A47442 36314021 BM LWRDEL2 NO, DON'T ISSUE MSG A66686 36321021 A R15,LWRTEN GET VOLID ADDR BACK A47442 36328021 BAL R9,LWRNOVOL ISSUE VOLID NOT A47442 36335021 * FOUND MSG A47442 36342021 * 36350016 LWRDEL2 EQU * A66686 36370021 DELETE EPLOC=LWRADRMV 36400016 * 36450016 LWRNOSCR MVI LWKADDSB,X'00' RESET BYTE FOR NEXT DSB A47442 36460021 * PROCESSING A47442 36470021 B LWRNX GO PROCESS NEXT SMB/DSB 36500016 LWRNOVOL MVC LWRBRTIT(6),0(R15) MOVE VOLID A47442 36503021 LWRNOVO2 MVI LWRBRTIT+6,LWRBLANK A47442 36506021 MVC LWRBRTIT+7(8),LWRQMNAM MOVE JOBNAME A47442 36509021 MVI LWRBRTIT+15,LWRBLANK A47442 36512021 MVC LWRBRTIT+16(8),TIOEDDNM MOVE DDNAME A47442 36515021 MVI LWRMSOFS+1,LWROFS74 MOVE OFFSET INTO CHOFS A47442 36518021 MVI LWRMSLEN,LWR24 NO. CHARA TO BE ADDED A47442 36521021 BAL R4,LWRCBLD BUILD MSG A47442 36524021 LH R7,0(R1) GET LENGTH OF MSG A47442 36527021 SH R7,LWRFOUR OMIT MCS CODE A47442 36530021 BAL R4,LWRITE35 SEND MSG TO CENTRAL A47442 36533021 BR R9 AND REMOTE A47442 36536021 * 36550016 LWRXDAD LH R0,DCBBLKSI GET SIZE OF BUFFER 36600016 L R1,LWKSTABF GET ADDR OF BUFFER 36650016 LTR R1,R1 DO WE REALLY HAVE ONE? A28219 36660019 BCR 8,R4 NO, RETURN A28219 36670019 XC LWKSTABF(4),LWKSTABF PREVENT FREEING OF CURRENTA47458 36675021 * SYSOUT BUFFER IF LINE A47458 36680021 * ERROR BETWEEN OPEN AND A47458 36685021 * GETMAIN FOR NEXT SYSOUT A47458 36690021 * DATA SET A47458 36695021 * 36700016 FREEMAIN R,LV=(0),A=(1) FREE BUFFER CORE AREA 36750016 * 36800016 BR R4 36850016 * 36900016 LWRXDA1 L R15,LWKADTCB GET ADDR OF TCB 36950016 L R1,LWKTIOTN GET ADDR OF NEW TIOT 37000016 ST R1,TCBTIO CHANGE TIOT PTR IN TCB TO NEW 37050016 * TIOT TEMPORARILY 37100016 IC R1,LWKDS GET DATA SET COUNT 19018 37110019 LA R1,1(R1) INCREMENT COUNT 19018 37120019 STC R1,LWKDS SAVE COUNT 19018 37130019 CLOSE ((8)) CLOSE SYSOUT DATA SET 37150016 * 37200016 L R1,LWKTIOTO GET ADDR OF OLD TIOT 37250016 L R15,LWKADTCB SET BASE TCB DSECT 37300016 * 37350016 ST R1,TCBTIO RESTORE OLD TIOT PTR INTO TCB 37400016 NI LCBWORKA,DATCLOSE CLEAR WORKA TO INDICATE LWR IS A28929 37410020 * FINISHED A28929 37420020 BR R4 37450016 * 37500016 LWRXDOPE L R1,LWKTIOTN GET ADDR OF NEW TIOT 37550016 L R0,LWKTIOTL GET BYTE SYZE OF NEW TIOT 37600016 * 000A 37650016 FREEMAIN R,LV=(0),A=(1) FREE CORE CONTAINING NEW TIOT 37700016 * 37750016 BR R4 37800016 EJECT 37850016 * MESSAGE QEB FOUND 37900016 * 37950016 LWRMSG DS 0H 38000016 BAL R14,LWRDEQEB DEQUEUE MSG QEB 000A 38050016 * 38100016 LWRMSGCN DS 0H 38150016 BAL R4,LWRMSGHE CHECK WRITE INIT BIT FLOP 000A 38200016 * 000A 38250016 MVC LWKID(7),LWRMSGHD SET HEADER FOR RJE MESSAGE 000A 38300016 XC LWKMDQK,LWKMDQK PRESET TO ZERO FOR IHKCDMDQ 38350016 TM 0(R6),LWRQEBRD+LWRQEBDL IS IT A DUMMY QEB 000A 38400016 BM LWRDUMQB YES, GO PROCESS DUMMY 000A 38450016 * 000A 38500016 * NO, ONE MSG TEXT IS IN QEB 38550016 LA R11,4(R6) PASS ADDR OF MSG TEXT 38600016 LA R7,LWR60 PASS LENGTH OF RJE MESSAGE 38650016 * 38700016 BAL R4,LWRITE TRANSMIT MESSAGES TEXT 38750016 * 38800016 LWRCPLM SR R0,R0 GET ZERO, INDICATING MSG 38850016 LWRCPLM3 BAL R14,LWRCPL GO CALL POOL MGR RET QEB 000A 38900016 MVI LWKSAVE6,X'FF' IN CASE OF DISCONTINUE A47972 38910021 * INDICATE MSG QEB A47972 38920021 * PROCESSING JUST COMPLETED A47972 38930021 * 38950016 B LWRANYQB TRY FOR ANOTHER QEB 39000016 * 39050016 LWRCPL ST R0,LWRPLM1 INDICATE MSG OR JOB 39100016 LA R1,LWRPLM1 PASS PARAMETER LIST TO RJE 39150016 * POOL MANAGER 39200016 XC TDIRFAST,TDIRFAST ZERO DISCONTINUED QEB A35881 39220020 ST R6,LWRPLM2 SET QEB ADDR TO BE RETURNED 39250016 L R15,IHKZZPLM 39300016 BR R15 CALL IHKCCPLM TO RETURN QEB000A 39350016 * TO POOL 39400016 * 39450016 LWRDUMQB DS 0H DUMMY QEB FOUND (MSG OR BRDCST) 000A 39500016 * 000A 39550016 LOAD EPLOC=LWRADMDQ GET DEQUEUE ROUTINE 000A 39600016 * 000A 39650016 LR R9,R0 SAVE ENTRY POINT ADDRESS 000A 39700016 TM 0(R6),LWRQEBDL IS IT A DELAYED MSG QEB 000A 39750016 BO LWRMSGOT YES, PROCESS DEL MSGS 000A 39800016 * NO, PROCESS BRDCST 000A 39850016 LWRBRD2 MVC LWRBRTIT(6),LWRBRDL2 MOVE 'FOLLOW' TO MESSAGE AREA 39900016 BAL R4,LWRCBLDM CALL IHKCBLDM TO GET HEADER 39950016 * 40000016 BAL R4,LWRITE XMIT BRDCST HEADER 40050016 EJECT 40100016 * DUMMY QEB FOUND REQUESTING A SERIES OF 40150016 * TEXTS (BRDCST OR DELAYED MSG) TO BE SENT 40200016 * 40250016 LWRBRDOT NI LWKADISP,LWRGETBR GET PARAM LIST TO REQUEST 40300016 * BRDCST 40350016 B LWRSETP GO GET SERIES OF TEXTS 40400016 * 40450016 LWRMSGOT OI TDIRSWCH+1,TDIRDMGN SET PARAM LIST TO REQUEST 40500016 LWRMSGO OI LWKADISP,LWRGETMS DELAYED MSG TEXTS 40550016 * 40600016 LWRSETP LA R11,LWKBIN GET ADDR OF 60 BYTE I/O AREA 40650016 ST R11,LWKMDQIO PASS I/O AREA ADDR TO PARAMS 40700016 L R0,IHKZZTDR GET ADDR OF ENTIRE TDIR 40750016 SR R3,R0 CALCULATE DISPLACEMENT 40800016 ST R3,LWKMDQTD SET TERMINAL DIRECTORY ENTRY 40850016 * DISP. REQUEST EACH TEXT BE 40900016 * DELETED AS EACH IS RETRIEVED 40950016 * FROM THE DISC, RJETXT 41000016 L R3,LCBTDIR RESTORE R3 TO HAVE ADDR OF 41050016 * TERMINAL DIRECTORY ENTRY 41100016 LR R15,R9 GET MDQ ENTRY ADDRESS 000A 41150016 LA R1,LWKADCBS PASS ADDR OF PARAMETER LIST 41200016 BALR R14,R15 GET IHKCDMDQ TO RETRIEVE A 41250016 * MSG OR BRDCST TEXT FROM DISC 41300016 * 41350016 ST R1,LWKMDQK SAVE CONTROL VALUE FOR NEXT 41400016 * CALL 41450016 SH R15,LWRFOUR CHECK RETURN CODE 000A 41500016 * '0'-TEXT IS IN I/O AREA 41550016 * '4'-NO MORE TEXTS FOR 41600016 * THIS TERMINAL 41650016 * 'N'-N IS OFFSET OF I/O ERROR 41700016 * MSG 41750016 BM LWRHAVTX GO PROCESS TEXT 41800016 * 000A 41850016 BP LWRBMERR GO PROCESS I/O ERROR 41900016 EJECT 41950016 * ALL DELAYED MSG OR BRDCST HAVE BEEN SENT 42000016 * 42050016 LWRNOTXT DS 0H 42100016 TM TDIRSWCH+1,TDIRDMGN MSG OR BRDCST 42150016 BC 8,LWRBRD3 IF BRDCST, GO XMIT TRAILER 42200016 * 42250016 * IF MSG, TURN OFF SWITCHES 42300016 NI TDIRSWCH+1,TDIRDMGF TURN OFF DELAYED MSG PROCESSING 42350016 NI TDIRSTAT,TDIRDLMF TURN OFF DELAYED MSG AVAILABLE 42400016 * 42450016 LR R1,R3 PASS ADDR OF TDIR ENTRY 42500016 L R15,IHKZZTMR 42550016 BALR R14,R15 RECORD DELAYED MSG BIT ON DISC 42600016 * 42650016 LWRDEL DELETE EPLOC=LWRADMDQ REMOVE DEQUEUE ROUTINE 000A 42700016 * 000A 42750016 B LWRCPLM GO CALL POOL MGR 42800016 * 42850016 LWRHAVTX LA R7,LWR60 42900016 BAL R4,LWRITE TRANSMIT TEXT 42950016 * 43000016 TM TDIRSWCH+1,TDIRDMGN MSG OR BRDCST 43050016 * GO GET NEXT TEXT OF PROPER 43100016 * TYPE 43150016 BC 1,LWRMSGO GO GET NEXT DELAYED MSG TEXT 43200016 * 000A 43250016 B LWRBRDOT GO GET NEXT BRDCST TEXT 43300016 * 43350016 LWRBRD3 MVC LWRBRTIT(6),LWRBRDL3 MOVE 'END' TO MESSAGE AREA 43400016 * 43450016 BAL R4,LWRCBLDM CALL IHKCBLDM TO GET TRAILER 43500016 * 43550016 BAL R4,LWRITE XMIT BRDCST TRAILER 43600016 * 43650016 B LWRDEL DELETE MDQ,GO POOL MGR 000A 43700016 * 43750016 * DISC ERROR, BRDCST/DELAYED MSG 43800016 * 43850016 LWRBMERR LA R15,4(R15) RESET ERROR OFFSET 000C 43870018 STC R15,LWRMSOFS+1 PASS OFF SET ERROR MSG NO. 000C 43910018 MVI LWRMSLEN,LWR0 NO PARAMETERS TO ADD TO MESSAGE 43950016 BAL R4,LWRCBLD CALL BUILD MSG 44000016 * 44050016 BAL R4,LWRITE35 SEND ERROR MSG TO CENTRAL 000A 44100016 * AND REMOTE 000A 44150016 B LWRNOTXT ASSUME ALL BRDCST/DELAYED MSGS 44200016 * HAVE BEEN SENT 44250016 EJECT 44300016 * SMB HANDLER 44350016 * REGISTERS AT ENTRY - 44400016 * R5 IS BASE OF WORKAREA. 44450016 * ORIGINAL CONTENTS OF R1, R7, R8, R14, R15 ARE LOST. 44500016 * REGISTER USAGE - 44550016 * R1 IS USED AS LOOP COUNTER AND IN CONTROLLING THE EX INSTR. 44600016 * R6 POINTS TO THE NEXT BYTE IN THE MSG BUFFER TO BE FILLED. 44650016 * R7 HAS SIZE OF THE FINISHED MSG. 44700016 * R8 IS POINTING TO THE SMB BYTE CURRENTLY BEING OBSERVED. 44750016 * THE SMB IS ASSUMED TO BE IN PLACE IN CORE 44800016 * 44850016 LWRSMB LA R8,SMBMSGLN GET LENGTH BYTE ADDR 44900016 ST R6,LWKSAVE6 SAVE R6 - QEB POINTER 44950016 LA R15,JEDTSOUT GET ADDR OF SMB SYSOUT CLASS 45000016 BAL R4,LWRSETID SET HEADER TO OUTPUT DEVICE 45050016 * 45100016 XC LWKRECSZ,LWKRECSZ CLEAR RECSIZE TO ZERO 45150016 MVI LWKCNTRL,LWKNONEH SET TO NO CONTROL CHARS 45200016 MVI LWKRECFM,LWKUNDFH SET TO UNDEFINED 45250016 LWRSMBT0 LA R6,LWKBIN GET ADDR OF OUTPUT BUFFER 45350016 SR R7,R7 CLEAR MSG SIZE COUNTER 45400016 CLI 0(R8),LWR0 ANY MORE MSGS IN THIS SMB 45450016 BE LWRSMBX IF NOT, GO TO EXIT 45500016 * 45550016 LA R15,SMBEND IS SMB POINTER BEYOND SMB 45600016 CR R8,R15 45650016 BL LWRSMBL1 IF NOT, GO PROCESS SMB TEXT 45700016 * 45750016 BE LWRSMBX END OF SMB A32865 45770020 * 45800016 LWRSMBX L R6,LWKSAVE6 RESTORE R6 TO ADDR OF QEB 45850016 BAL R4,LWRITE0 EMPTY BUFFER OF SMB TEXT 45900016 * 000A 45950016 OI TDIRSWCH+2,TDIRHDRN SUPPRESS GENERATION OF NEW 46000016 * HEADER 46050016 B LWRNX EXIT TO GET NEXT SMB/DSB 46100016 * 46150016 LWRSMBL1 CLI 0(R8),LWRSMBCN IS THIS SMB TEXT CONDENSED 46200016 BNE LWRSMBNC YES, PROCESS NON-CONDENSED TEXT 46250016 * NO, CONTINUE AND PROCESS 46300016 * CONDENSED TEXT 46350016 * SMB TEXT IS CONDENSED 46400016 SR R14,R14 46450016 IC R14,1(R8) GET LENGTH OF ENTIRE MESSAGE 46490019 LR R15,R8 46530019 AR R15,R14 R15 POINTS TO NEXT MSG 46570019 LA R8,1(R8) BUMP SMB POINTER TO MSG LENGTH 46610019 LWRSMBL2 EQU * A28214 46650019 SR R1,R1 46950016 IC R1,1(R8) GET LENGTH OF TEXT FIELD A28214 47000019 LA R8,2(R8) POINT TO FIRST OF TEXT A28214 47005020 LTR R1,R1 TEST IF ELNGTH IS ZERO A28491 47010020 BZ LWRSMBBL NO, PROCESS BLANKS THEN A29491 47030020 AR R7,R1 ADD LENGTH TO MSG TOTAL 47050019 CH R7,LWRSMBMX WILL THIS TEXT OVERRUN BUFFER A29491 47055020 BNH LWRSMBNF NO, GO AHEAD AND MOVE TXT A29491 47060020 SMBTOBIG SR R7,R1 RE-ADJUST BUF LNGTH INDICATOR A29491 47065020 LR R8,R15 AFT WRITTING THIS MSG R8 MUST A29491 47070020 * BE POINTING TO 1ST OF NXT MSG A29491 47075020 B LWRSMBTX XMIT MSG NOW, DON'T OVERRUN A29491 47080020 * BUFFER WITH >144 CHARS. A29491 47085020 LWRSMBNF EQU * MOVE TXT, BUF WILL NOT OVERUN A29491 47090020 BCTR R1,R0 ADJUST LENGTH FOR EX INSTR 47100019 * 47200016 EX R1,LWRSMBMT MOVE TEXT TO BUFFER 47250016 * 47300016 LA R6,1(R1,R6) BUMP BUFFER POINTER TO NEXT 47350016 * BYTE TO BE FILLED IN 47400016 LA R8,1(R1,R8) BUMP SMB POINTER PAST TEXT 47450016 * FIELD 47500016 CR R8,R15 IS POINTER AT NEXT MSG ALREADY 47550016 BL LWRSMBBL NO, GO PROCESS BLANK FIELD 47600016 * YES, COMPLETE MSG IS IN BUFFER 47650016 * 47700016 * CALL XMIT TO SEND SMB 47750016 * 47800016 LWRSMBTX LA R11,LWKBIN PASS BUFFER ADDR 47850016 * 47900016 BAL R4,LWRITE XMIT MSG 47950016 * 48000016 B LWRSMBT0 GO GET NEXT MSG FROM THIS 48050016 * SAME SMB, IF ANY LEFT 48100016 * 48150016 * PROCESS BLANK FIELD 48200016 * 48250016 LWRSMBBL SR R1,R1 48300016 IC R1,0(R8) GET COUNT OF BLANKS 48350016 LTR R1,R1 TEST IF BLANK LENGTH IS ZERO A29491 48360020 BZ LWRSMBL2 IF ZERO, PROCSSS NEXT TEXT A29491 48370020 AR R7,R1 ADD LENGTH TO TOTAL LENGTH CNTR 48400016 CH R7,LWRSMBMX WILL THESE BLANKS OVERRUN BUF A29491 48410020 BH SMBTOBIG IF SO DON'T ADD THE BLANKS A29491 48420020 * 48450016 LWRSMBL3 MVI 0(R6),LWRBLANK PUT A BLANK CHARACTER INTO MSG 48500016 LA R6,1(R6) BUMP BUFFER PTR TO NEXT BYTE 48550016 BCT R1,LWRSMBL3 GO GET NEXT BLANK, IF ANY 48600016 * 48650016 B LWRSMBL2 GO GET NEXT TEXT FIELD 48700016 * 48750016 * TEXT IS NOT CONDENSED 48800016 * 48850016 LWRSMBNC SR R1,R1 48900016 IC R1,0(R8) GET MSG LENGTH 48950016 LR R7,R1 PASS MSG LENGTH TO XMIT ROUTINE 49000016 LR R15,R8 GET ADDR OF THIS MSG 49050016 AR R15,R7 ADD SIZE OF THIS MSG 49100016 LA R15,1(R15) R15 POINTS TO NEXT MSG 49150016 CLI 0(R8),L'LWKBIN IS TEXT TOO LONG 49200016 BNH LWR28214 NO - KEEP WORKING A28214 49230019 LA R1,144 YES - TRUNCATE MESSAGE A28214 49260019 LWR28214 EQU * A28214 49290019 LA R8,1(R8) POINT TO FIRST TEXT BYTE 49350016 BCTR R1,R0 ADJUST LENGTH FOR EX INSTR 49400016 EX R1,LWRSMBMT MOVE TEXT TO BUFFER 49450016 LR R8,R15 POINT TO LENGTH BYTE OF NEXT 49500016 * MSG TEXT 49550016 B LWRSMBTX GO XMIT TEXT 49600016 * 49650016 * ERROR - SMB TEXT TOO LONG 49700016 EJECT 49850016 *********************************************************************** 49900016 * 49950016 * DISCONTINUE 50000016 * 50050016 *********************************************************************** 50100016 IHKABLW1 DS 0H 50150016 * LCBPARM1 INDICATES REASON FOR FAILURE TO XMIT BLOCK. A50147 50154021 * VALUE = NEG, LINE CONTENTION A50147 50158021 * VALUE = 13, LINE FAILURE A50147 50162021 * VALUE = 4, FORMS CHANGE A50147 50166021 * VALUE = 0, DISCONTINUE REQUESTED BY REMOTE A50147 50170021 L R7,LCBPARM1 SAVE INPUT PARAMETER A50147 50174021 NI TDIRSWCH+1,TDIRCNTF TURN OFF DISCONTINUE A50147 50178021 CLI LWKSAVE6,X'FF' TEST FOR COMPLETED A50147 50182021 BE LWRMSQEB PROCESSING OF MSG QEB A50147 50186021 * BRANCH IF TRUE A50147 50190021 L R6,LWKSAVE6 GET QEB POINTER 50200016 ST R6,TDIRFAST SAVE QEB ADDR FOR CONTINUE RTN 50250016 * 000A 50300016 LTR R6,R6 TEST FOR COMPLETION OF JOBA50147 50310021 * OUTPUT TRANSMISSION. DID A50147 50320021 * DISCONTINUE OCCUR AFTER A50147 50330021 * ALL SYSOUT DATA XMITTED A50147 50340021 BNZ LWRNOEND BRANCH IF NOT COMPLETED A50147 50350021 L R1,LWKADFST A50147 50360021 USING FASTAB,R1 A50147 50370021 CLI FASTNAME,FASTINAC DISCONTINUE OCCUR BEFORE A50147 50380021 * FAST ENTRY INACTIVATED A50147 50390021 BNE LWRWRT BRANCH IF YES A50147 50400021 TM FASTJIB,FASTNINN CHECK NOTIFY TEXT BIT A50147 50410021 BZ LWRNOWRT IF NOT ON DON'T WRITE FASTA50147 50420021 LWRWRT MVI FASTNAME,FASTINAC INACTIVATE FAST ENTRY A50147 50430021 NI FASTJIB,FASTNINF TURN OFF NOTIFY INFO BIT A50147 50440021 DROP R1 A50147 50450021 BAL R14,LWRCLFMR WRITE FAST A50147 50460021 LWRNOWRT TM TDIRSWCH,LWRX02 DISCONTINUE OCCUR BEFORE A50147 50470021 * SMF RECORD WRITTEN AND A50147 50480021 * QEB RETURNED TO FREE POOL A50147 50490021 BZ LWRMSQEB BRANCH IF NO A50147 50500021 NI TDIRSWCH,TDIRJOBF TURN OFF JOB SWITCH A50147 50510021 BAL R9,LWRSMF WRITE SMF RECORD A50147 50520021 LR R0,R12 A50147 50530021 BAL R14,LWRCPL FREE QEB A50147 50540021 NI TDIRSWCH+1,TDIRCNTF TURN OFF CONTINUE A50147 50550021 LWRMSQEB XC LWKSAVE6,LWKSAVE6 INDICATE THAT DISCONTINUE A50147 50560021 * OCCURRED AFTER ALL MSG OR A50147 50570021 * JOB OUTPUT XMITTED FOR A50147 50580021 * REST OF DISCONTINUE A50147 50590021 * PROCESSING A50147 50600021 B LWRNOTO BYPASS CODE TO HANDLE A50147 50610021 * DISCONTINUE IN MIDDLE OF A50147 50620021 * OUTPUT PROCESSING A50147 50630021 LWRNOEND TM 0(R6),LWRQEBRD+LWRQEBDL DUMMY QEB IN PROCESS A50147 50640021 BZ LWRSKDEL NO, SKIP DELETE 000A 50750016 * YES, CONTINUE 000A 50800016 DELETE EPLOC=LWRADMDQ REMOVE DEQUEUE ROUTINE 000A 50850016 * 000A 50900016 LWRSKDEL DS 0H 000A 50950016 DROP R8 51100016 L R8,LCBDDECB GET ADDR OF SYSOUT DCB 51150016 USING IECTDECB,R8 51200016 L R8,DECDCBAD INTO REGISTER 8 51250016 DROP R8 51300016 USING IHADCB,R8 51350016 TM DCBOFLGS,LWRDCBOP IS SYSOUT DATA SET OPEN 51400016 BZ LWRNOTO BRANCH IF NOT OPEN 51450016 * CONTINUE IF IT IS OPEN 51500016 * THIS CODE SAVES THE VOLUME SEQ NUMBER FOR CONTINUING A32869 51503020 * MULTI VOLUME DATA SETS. A32869 51506020 L R15,DCBDEBAD PICK UP DEB ADDRESS A32869 51509020 DROP R15 A32869 51512020 USING IECTDEB,R15 A32869 51515020 SR R1,R1 CLEAR REG FOR IC A32869 51518020 IC R1,DEBXCEA PICK UP NUM OF EXTENTS A32869 51521020 DROP R15 A32869 51524020 USING LWRTCB,R15 GIVE R15 BACK TO TCB DSECT A32869 51527020 SLL R1,4 MULTIPLY BY 16 A32869 51530020 LA R15,33(R15) BUMP TO PROPER DISP A32869 51533020 AR R15,R1 POSITION R15 TO VOL SEQ NUMBER IN DEB A32869 51536020 MVC TDIRVOLS(1),0(R15) SAVE VOL SEQ NUM FOR CONTINUE A40162 51540020 * 51545020 BAL R4,LWRXDAD FREE CORE SYSOUT BUFFER 51550016 * 000A 51600016 BAL R4,LWRXDA1 CLOSE SYSOUT DATA SET 51650016 * 000A 51700016 BAL R4,LWRXDOPE FREE CORE OF NEW TIOT 51750016 * 000A 51800016 SR R0,R0 51850016 IC R0,LWKSYSCT GET SYSOUT CLASS POINTER 51900016 BCTR R0,0 SUBTRACT ONE FROM POINTER 51950016 STC R0,LWKSYSCT REPLACE POINTER 52000016 LWRNOTO DS 0H 52050016 LTR R7,R7 IS THIS A DISCONTINUE OR 52100016 * LINE FAILURE 52150016 BM LWRINTDS BRANCH IF CONTENTION 52200016 * 52250016 NI TDIRSTAT,TDIRNQJF HALT ENQUEUING MORE JOBS 52300016 OI TDIRSWCH+1,TDIRDISN TURN ON DISCONTINUE 52350016 L R1,IHKZZECB GET ADDR OF IHKCCPLM ECB 52400016 MVI 0(R1),LWRPOST POST MSG QEB ECB FOR IHKCCPLM 52450016 MVI 4(R1),LWRPOST POST MSG JOB ECB FOR IHKCCPLM 52500016 LWRDIS DS 0H 52550016 LTR R6,R6 TEST FOR DISCONTINUE A50147 52560021 * OCCURRING AFTER QEB A50147 52570021 * COMPLETELY PROCESSED A50147 52580021 BZ LWRNOTJB BRANCH IF YES A50147 52590021 TM 0(R6),LWRQEBMS TEST IF MSG QEB A32852 52600020 BO LWRNOTJB BRANCH IF MSG QEB A32852 52650020 * CONTINUE IF IS JOB 52700016 MVC JEDTNMSG(24),LWKSYSCT SAVE HEADER 19018 52750019 L R1,LWKADFST GET ADDR OF FASTABLE ENTRY 000A 52800016 USING FASTAB,R1 000A 52850016 TM FASTJIB,FASTNINN CHECK NOTIFY TEXT BIT 000A 52900016 BZ LWRSKCLF IF OFF, SKIP CALL FMR 000A 52950016 * IF ON, CONTINUE 000A 53000016 NI FASTJIB,FASTNINF TURN OFF NOTIFY INFO BIT 000A 53050016 DROP R1 000A 53100016 BAL R14,LWRCLFMR RECORD FASTABLE ON DISC 000A 53150016 * 53200016 LWRSKCLF DS 0H 000A 53250016 CLC JEDTTTR0(3),LWRFZERO IF WE HAVE NOT READ THE A37762 53260021 BE LWRNOTJB JED IN, THEN DON'T WRITE IT OUT A37762 53270021 LA R0,JEDTNMSG PASS ADDR OF CORE JED 53300016 O R0,LWRBLDM REQUEST 'WRITE' FUNCTION 53350016 BAL R14,LWRCALJD WRITE JED TO DISC 000A 53400016 * 53450016 SH R15,LWRFOUR CHECK RETURN CODE 53500016 BZ LWRJEDWR BRANCH IF WRITE ERROR 53550016 * CONTINUE IF GOOD WRITE 53600016 LWRNOTJB DS 0H 53650016 LA R15,LWROFS13 GET VALUE SAYING LINE FAILED 53700016 CR R15,R7 DID LINE FAIL 53750016 BE LWRLF YES, LINE FAILURE 53800016 * CONTINUE IF DISCONTINUE 53850016 CLI LCBTYPLN,LCBSWTCH IS LINE SWITCHED 53900016 BE LWRDOABT YES, GO SET EXIT TO ABEOT 53950016 * 54000016 LR R8,R12 NO, SET EXIT TO ABREQ 54050016 CH R7,LWRFOUR IS THIS DISCONTINUE FORM CHANGE 54100016 BE LWREOT YES, SEND EOT TO REMOTE 54150016 * 54200016 B LWREXIT DO NOT EOT, JUST EXIT 54250016 * 000A 54300016 * WRITE ERROR JED 54350016 LWRJEDWR DS 0H 000A 54400016 MVI LWRDT2PA,LWRX80 INDICATE JED IS ALREADY IN CORE 54450016 MVC LWRDT2PA+1(3),LWKADJED+1 GET ADDR OF CORE JED 54500016 ST R10,LWRDT2P2 PASS ADDR OF AVT 000A 54550016 * 000A 54600016 LOAD EPLOC=LWRADDT2 LOAD JOB DELETE ROUTINE 000A 54650016 * 000A 54700016 LR R15,R0 SAVE ENTRY POINT ADDR 000C 54750018 LA R1,LWRDT2PA PASS ADDR OF PARAMETERS 000A 54800016 BALR R14,R15 54850016 * 000A 54900016 DELETE EPLOC=LWRADDT2 000A 54950016 * 55000016 NI TDIRSWCH+1,TDIRDISF FORGET DISCONTINUE 55050016 NI TDIRSWCH+2,TDIRCDSF AND CONTENTION BITS 55100016 LR R0,R12 INDICATE JOB 55150016 BAL R14,LWRCPL GO CALL POOL MGR TO RETURN 000A 55200016 * JOB QEB TO POOL 55250016 LA R8,LWROFS65 TELL RJEND TO PRINT MESSAGE 55300016 * DISC ERROR JED 55350016 LWRCLRJF DS 0H PREPARE FOR EXIT TO RJENDF 55400016 LA R0,LWRSIZE GET SIZE OF GETMAIN WORKAREA 55450016 LR R1,R5 GET ADDR OF GETMAIN WORKAREA 55500016 * 000A 55550016 FREEMAIN R,LV=(0),A=(1) FREE WORKAREA CORE 55600016 ST R8,LCBPARM1 PASS OFFSET TO RJENDF 55650016 LA R15,LWR16 INDICATE RJENDF TO ABLST 55700016 B LWRSKIP1 EXIT TO RJENDF 55750016 * 000A 55800016 * LINE FAILURE 55850016 LWRLF LA R8,LWROFS13 PASS MSG OFFSET - LINE ERROR 55900016 B LWRCLRJF 55950016 * 000A 56000016 * LINE CONTENTION 56050016 LWRINTDS OI TDIRSWCH+2,TDIRCDSN TURN ON CONTENTION DISCONTINUE 56100016 B LWRDIS GO PROCESS AS IF NORMAL 56150016 * DISCONTINUE 56200016 EJECT 56250016 *********************************************************************** 56300016 * 56350016 * INTERNAL SUBROUTINES 56400016 * 56450016 *********************************************************************** 56500016 * 56550016 * ROUTINE TO TRANSMIT TO PRINTER 56600016 * 56650016 * R7 HAS NUMBER BYTES TO BE SENT 56700016 * R11 POINTS TO RECORD TO BE OUTPUT 56750016 * 56800016 LWRITE0 SR R7,R7 INDICATE END OF DATA SET 56850016 B LWRITE BRANCH AROUND INCREMENT 19018 56858019 LWRITE1 DS 0H 19018 56866019 L R1,LWKCOUNT GET SYSOUT COUNT 19018 56874019 LA R1,1(R1) INCREMENT COUNT 19018 56882019 ST R1,LWKCOUNT 19018 56890019 LWRITE DS 0H 56900016 ST R7,LCBPARM1 PASS NO. BYTES 56950016 ST R11,LCBPARM2 PASS ADDR OF DATA 57000016 LA R1,IHKZZLCB PASS ADDR OF PARAM LIST 57050016 ST R2,IHKZZLCB PASS LCB ADDR INTO PARM LIST 57100016 L R15,IHKZZLWT 57150016 BALR R14,R15 CALL XMIT ROUTINE 57200016 * 57250016 LTR R15,R15 CHECK RETURN CODE 57300016 BCR 8,R4 RETURN TO MAIN CODE IF OK 57350016 TM TDIRRB,X'40' WHY ARE WE HERE? A28219 57360019 BCR 1,R4 NO CORE, RETURN A28219 57370019 TM TDIRSTAT,TDIRNQMN TERMINAL RJENDED ? A57017 57400021 BO IHKABLW1 NO - DISCONTINUE OUTPUT A57017 57420021 SR R8,R8 SET RETURN CODE FOR ABLST A57017 57440021 B LWRTSW CONTINUE RJEND A57017 57460021 * 000A 57500016 LWRITE35 DS 0H SEND ERROR MSG TO CENTRAL 000A 57550016 SVC 35 WTO 000A 57600016 * 000A 57650016 LWRITER1 DS 0H 000A 57700016 MVI 3(R11),LWRCHAR1 WHEN SAME MSG IS SENT TO 000A 57750016 * CENTRAL AND REMOTE,INSERT000A 57800016 * '1' INTO MSG NO. TO 000A 57850016 * IDENTIFY REMOTE MSG 000A 57900016 * SEND ERROR MSG TO REMOTE 000A 57950016 MVC LWKID(7),LWRMSGHD SET HEADER FOR RJE MESSAGE 000A 58200016 B LWRITE GO XMIT TO REMOTE 000A 58250016 EJECT 58300016 * DEQUEUE QEB 58350016 * 58400016 LWRDEQEB LA R1,LWRQMGTD PASS PARAMETER LIST ADDR 58450016 XC TDIRFAST,TDIRFAST ZERO DISCONTINUED QEB PTR A32852 58470020 XC LWRQMG0(4),LWRQMG0 REQUEST 'DEQUEUE' 58500016 ST R3,LWRQMGTD SET ADDR TERMINAL DIRECTORY 58550016 * ENTRY INTO PARAMETER LIST 58600016 L R15,IHKZZQMG CALL RJE Q MANAGER TO 58650016 BR R15 DEQUEUE NEXT QEB 000A 58700016 * 58750016 * * * * * * * *RESET OLD AND NEW TIOT PTRS IN TCB * * * * * * * * * * * 58800016 * 58850016 LWROTIO L R15,LWKADTCB GET ADDR OF TCB 58900016 MVC TCBTIO,LWKTIOTO RESTORE OLD TIOT ADDRESS 58950016 BR R4 59000016 * 59050016 LWRNTIO L R15,LWKADTCB GET ADDR OF TCB 59100016 MVC TCBTIO,LWKTIOTN GET NEW TIOT ADDRESS 59150016 BR R4 59200016 * 000A 59250016 * * * * * * * * * * * * * CALL IHKCDFMR (FASTABLE MANAGER) * * * * 000A 59300016 * 000A 59350016 LWRCLFMR L R15,IHKZZFMR GET ADDR OF FASTABLE MANAGR000A 59400016 BR R15 RECORD FASTABLE ON DISC 000A 59450016 * RETURN VIA R14 TO MAIN RT000A 59500016 EJECT 59550016 * READ/WRITE JED TABLE 59600016 * 59650016 * INPUT - R0 HAS ADDR OF CORE AREA TO CONTAIN JED 59700016 * SIGN BIT INDICATES READ OR WRITE 59750016 * '0'-READ 59800016 * '1'-WRITE 59850016 * 59900016 * R6 HAS ADDR OF QEB 59950016 * 60000016 LWRCALJD ST R0,LWKADJED PASS ADDR OF CORE JED 60050016 MVC LWKADFST(4),4(R6) SECOND WORD OF JOB QEB HAS 60100016 * ADDR OF FASTABLE ENTRY 60150016 LA R1,LWKADFST PASS ADDR OF PARAM LIST 60200016 L R15,IHKZZJMR GET JED MANAGER ENTRY ADDRESS 60250016 BR R15 CALL JED TABLE MANAGER, AND 60300016 * RETURN TO ADDR IN R14 000A 60350016 * 60400016 * READ ERROR JED 60450016 * 60500016 LWRJEDRE MVI LWRMSOFS+1,LWROFS65 DISC ERROR JED JOBNAME 60550016 MVI LWRMSLEN,LWR8 60600016 L R1,LWKADFST GET ADDR OF FASTABLE ENTRY 000A 60650016 USING FASTAB,R1 000A 60700016 MVC LWRBRTIT(8),FASTNAME ADD JOBNAME TO MSG 000A 60750016 BAL R4,LWRCBLD CALL BUILDMSG 60800016 * 60850016 BAL R4,LWRITER1 SEND DISC ERROR MSG 000A 60900016 * TO REMOTE 000A 60950016 * 61000016 BAL R4,LWRITE0 START OR END OF DATA SET 61050016 * 61100016 L R1,LWKADFST 61150016 MVI FASTNAME,FASTDISA DISABLE FASTABLE ENTRY 61200016 DROP R1 61250016 BAL R14,LWRCLFMR RECORD FASTABLE ON DISC 000A 61300016 * 61350016 B LWROFJO GO TURN OFF JOB SWITCH 61400016 EJECT 61450016 * CALL OS Q MANAGER TO READ DSB/SMB 61500016 * 61550016 LWREADSB MVI LWRQMPOP,LWRQMRED REQUEST 'READ' FUNCTION 61600016 MVC LWRQMPEX,JEDTTTR0 GET TTR OF THIS DSB/SMB TO 61650016 * QMPA EXTENSION 61700016 MVI LWRQMPEX+3,LWR0 MAKE TTR BECOME TRR0 61750016 LA R0,JEDTTTR0 GET ADDR OF CORE AREA TO 61800016 * RECEIVE DSB/SMB 61850016 ST R0,LWRQMPCA SET I/O AREA ADDR IN QMPA EXT. 61900016 LA R0,LWRQMPCA GET ADDR OF QMPA EXTENSION 61950016 ST R0,LWRQMPCL PASS ADDR OF EXTENSION 62000016 MVI LWRQMPNC,LWR1 REQUEST ONE RECORD TO BE READ 62050016 ST R4,LCBPARM3 SAVE RETURN ADDRESS 000A 62100016 BAL R4,LWRCLQM GO READ NEXT DSB/SMB 000A 62150016 * 000A 62200016 L R4,LCBPARM3 RESTORE EXIT ADDRESS 000A 62250016 * RETURN CODE IS IN LOW ORDER BYTE 000A 62300016 * OF ECB WHOSE ADDRESS IS IN R1 000A 62350016 CLI 3(R1),LWR0 TEST RETURN CODE 000A 62400016 BNZ LWRQM12 I/O ERROR 62450016 * 000A 62500016 CLI SMBIDENT,LWRDSB15 IS THIS A DSB 19018 62505019 BCR 7,R4 NO, ITS AN SMB A63558 62510021 CLI SMBMSGLN,LWRDSBFF DATA SET USED (VALID DSB)? A63558 62511021 BCR 7,R4 NO - IGNORE A63558 62512021 SR R1,R1 ZERO FOR IC 19018 62515019 IC R1,TIOELNGH LENGTH OF TIOT ENTRY 19018 62520019 LA R15,TIOELNGH ADDRESS OF TIOT 19018 62525019 LA R1,16(R1,R15) ADDRESS OF JOB LOG 19018 62530019 MVC LWKSSYSD(28),0(R1) SAVE JOBNAME AND ETC. 19018 62535019 LWNODSB EQU * 19018 62540019 BR R4 CONTINUE IF GOOD READ 62550016 * 000A 62600016 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *000A 62650016 * 000A 62700016 * CALL IHKCBLDM FOR MESSAGE OFFSET 53 62750016 * BROADCAST HEADER + TRAILER 62800016 * 62850016 LWRCBLDM MVI LWRMSOFS+1,LWROFS53 OFFSET OF BRDCST HEADER/TRAILER 62900016 MVI LWRMSLEN,LWR6 62950016 LWRCBLD LA R1,LWRBLDM SET ADDR OF PARAMETER LIST 63000016 L R15,IHKZZLDM 63050016 BALR R14,R15 CALL BUILD MESSAGE, IHKCBLDM 63100016 * 63150016 MVC LWKBIN(64),0(R1) GET MSG FROM BUILDMSG 000A 63200016 LA R11,LWKBIN+4 63250016 * MESSAGE TEXT 63300016 LA R7,LWR60 SET TEXT LENGTH 63350016 BR R4 EXIT 63400016 EJECT 63450016 * CONDITIONAL GETMAIN 63500016 * FOR WORKAREA, NEW TIOT, 63550016 * OR INPUT BUFFER 63600016 * 63650016 LWRGETMA DS 0H 63700016 L R1,LCBBUFER GET ADDR OF LINE BUFFER AREA 63750016 MVC 0(10,R1),LWRGETMM MOVE OUT GETMAIN PARAMETER AREA 63800016 ST R0,0(R1) STORE NUMBER OF BYTES 63850016 LA R0,LWRWORD PASS ADDR OF WORD TO RECEIVE 63900016 ST R0,4(R1) ADDR OF GETMAIN AREA 63950016 * 64000016 GETMAIN ,MF=(E,(1)) REQUEST CORE 64050016 * 64100016 LTR R15,R15 SET CONDITION CODES FOR CALLER 64150016 BR R4 RETURN TO CALLER 64200016 * 64250016 LWRGETMM GETMAIN EC, PARAM LIST FOR UNCONDITIONAL *64300016 A=LWRGETMM, REPLACED BY A(LWRWORD) *64350016 LV=500, REPLACED BY ACTUAL COUNT *64400016 MF=L 64450016 * 64500016 * GETMAIN FAILED FOR TIOT 64550016 * OR FOR SYSOUT BUFFER 64600016 * 64650016 LWRERGM DS 0H 64700016 BAL R4,LWRITE0 START OR END OF DATA SET 64750016 * 64800016 MVC LWRBRTIT(8),LWRQMNAM GET JOBNAME, 64850016 MVI LWRBRTIT+8,LWRBLANK BLANK, AND 64900016 MVC LWRBRTIT+9(8),TIOEDDNM DDNAME TO BUILD MSG 64950016 MVI LWRMSLEN,LWR17 65000016 MVI LWRMSOFS+1,LWROFS54 OUT OF CORE SPACE 65050016 * 65100016 BAL R4,LWRCBLD GET ERROR MSG 65150016 * 65200016 BAL R4,LWRITE35 SEND ERROR MSG TO CENTRAL 000A 65250016 * AND REMOTE 000A 65300016 BR R6 65350016 EJECT 65400016 * SYSOUT DCB INTERPRETER 65450016 * HEADER PREPARATION 65500016 * 65550016 * R8 HAS DISC DCB ADDR AT ENTRY 65600016 * R7 IS SET TO DISC DECB ADDR DURING EXECUTION 65650016 * R15 IS USED AS A WORK REGISTER 65700016 * JEDTABLE MUST BE IN CORE 65750016 * 65800016 * DCBRECFM DEFINES THE RECORD FORMAT AS FOLLOWS - 65850016 * 65900016 * IN BITS 0-1 - 65950016 * B'10' - FIXED 66000016 * B'01' - VARIABLE 66050016 * B'11' - UNDEFINED 66100016 * 66150016 * IN BIT 3 66200016 * B'1' - BLOCKED 66250016 * B'0' - UNBLOCKED 66300016 * 66350016 * IN BITS 5-6 - 66400016 * B'10' - ASA CONTROL CHARACTER 66450016 * B'01' - MACHINE CONTROL CHAR 66500016 * B'00' - NO CONTROL CHARACTER 66550016 LWRHEAD DS 0H 000A 66600016 ST R4,JEDTNMSG+10 PRESERVE RETURN ADDR 000A 66650016 XC LWKRECSZ,LWKRECSZ CLEAR RECSIZE TO ZERO 66700016 TM DCBRECFM,LWRX80 66750016 BO LWRFORU BRANCH IF 'F' OR 'U' 66800016 * 66850016 * DATA IS VARIABLE 66900016 TM DCBRECFM,LWRX10 66950016 BO LWRVBLK BRANCH IF VARIABLE BLOCKED 67000016 * 67050016 MVI LWKRECFM,LWKVAUBH SET TO VARIABLE UNBLOCKED 67100016 B LWRCKCAR 67150016 * 67200016 LWRVBLK MVI LWKRECFM,LWKVARBH SET TO VARIABLE BLOCKED 67250016 B LWRCKCAR 67300016 * 67350016 LWRFORU TM DCBRECFM,LWRX40 67400016 BO LWRUNDEF BRANCH IF UNDEFINED 67450016 * 67500016 * DATA IS FIXED 67550016 MVC LWKRECSZ+2(2),DCBLRECL PASS LOGICAL RECORD LENGTH FOR 67600016 * FIXED RECORDS 67650016 TM DCBRECFM,LWRX10 67700016 BO LWRBLFX BRANCH IF FIXED BLOCKED 67750016 * 67800016 MVI LWKRECFM,LWKFXUBH SET TO FIXED UNBLOCKED 67850016 B LWRCKCAR 67900016 * 67950016 LWRBLFX MVI LWKRECFM,LWKFXBLH SET TO FIXED BLOCKED 68000016 B LWRCKCAR 68050016 * 68100016 LWRUNDEF MVI LWKRECFM,LWKUNDFH SET TO UNDEFINED 68150016 * 68200016 LWRCKCAR DS 0H 68250016 TM DCBRECFM,LWRX02 CHECK FOR MACHINE CONTROL CHAR 68300016 BO LWRMACON 68350016 * 68400016 TM DCBRECFM,LWRX04 CHECK FOR ASA CONTROL CHAR 68450016 BO LWRASACN 68500016 * NO CONTROL CHAR 68550016 MVI LWKCNTRL,LWKNONEH SET TO NO CONTROL CHARACTERS 68600016 B LWRSKIP2 68650016 * 68700016 LWRMACON MVI LWKCNTRL,LWKMACHH SET HEADER TO 'MACHINE 68750016 B LWRSKIP2 CONTROL CHAR' 68800016 * 68850016 LWRASACN MVI LWKCNTRL,LWKASACH SET HEADER TO 'ASA CONTROL 68900016 * CHARACTER' 68950016 LWRSKIP2 DS 0H 69000016 IC R15,LWKSYSCT GET SYSOUT CLASS POINTER 69050016 LA R15,1(R15) BUMP TO NEXT SYSOUT CLASS 69100016 CH R15,LWRH24 IS THIS SYSOUT CLASS TYPE IN 69150016 * THE JED TABLE 69200016 BH LWRGT24 MORE THAN 24, PRINTER 19018 69250019 * TO PRINTER 69300016 STC R15,LWKSYSCT SAVE UPDATED COUNTER 69350016 LA R15,JEDTSOUT-1(R15) GET ADDR OF CHARACTER DEFINING 69400016 * SYSOUT CLASS 69450016 LR R14,R15 GET CLASS POINTER 19018 69453019 BCTR R14,0 STEP BACK ONE 19018 69456019 CLC 0(1,R14),0(R15) CHANGE OF CLASS? 19018 69459019 BE LWRSETID NO, NO SMF WRITE 19018 69462019 * NOTE: R4 WILL BE USED IN THE SUBROUTINE LWRSMF FOR A BAL REG 19018 69465019 * IT IS FOR THIS REASON THAT IT IS BEING SAVED NOW RATHER THAN 19018 69468019 * AFTER THE SUBROUTINE IS FINISHED. 19018 69471019 ST R4,JEDTNMSG+10 SAVE RETURN ADDRESS 19018 69474019 MVC LWKCLASS,0(R14) SET OUTPUT CLASS 19018 69477019 BAL R9,LWRSMF WRITE SMF RECORD 19018 69480019 MVC LWKCLASS,0(R15) UPDATE CLASS NOW 19018 69483019 B LWRHDSMF STEP AROUND STORE OF R4 19018 69486019 LWRSETID DS 0H 69500016 ST R4,JEDTNMSG+10 SAVE RETURN ADDRESS 69550016 LWRHDSMF DS 0H 19018 69570019 L R1,IHKZZSOC GET ADDR OF CHAR DEFINITIONS 69600016 * OF SYSOUT DEVICES AS SET BY 69650016 * RJE SYSGEN MACRO 69700016 CLC 2(1,R1),0(R15) IS 'USER EXIT' REQUESTED 69750016 BE LWRUSX BRANCH IF YES, USER EXIT 69800016 * 69850016 CLC 1(1,R1),0(R15) IS 'PUNCH' REQUESTED 69900016 BNE LWRIDPRT IF NO, GO TO PRINTER 69950016 * IF PUNCH, CONTINUE 70000016 TM TDIRSWCH+2,TDIRPCHN IS REQUESEED PUNCH DEVICE 70050016 * AVAILABLE 70100016 BZ LWRIDPUN IF YES, GO TO PUNCH 70150016 * 000A 70200016 B LWRIDPRT IF NOT, GO TO PRINTER 70250016 * 70300016 * USER EXIT REQUESTED. IMPOSSIBLE 70350016 * IF 2780,VALID ONLY FOR CPU 70400016 LWRUSX TM TDIRSWCH+2,TDIRMCHN IS IT A 2780 70450016 BZ LWRIDPRT YES, SO USER EXIT REQUEST IS 70500016 * INVALID. GO TO PRINTER 70550016 MVI LWKID,LWKUSEXH NO, CPU DOES HAVE USER EXIT 70600016 * SET HEADING TO USER EXIT 70650016 * 70700016 TM SMBMSGLN,LWRDSBFF CHECK FOR SMB PROCESSING 1652 70710018 BM LWRSKIP3 FORGET THESE GYRATIONS 1652 70720018 SPACE 70730018 * CHECK USER EXIT LIMIT OF 400 BLKSIZE 70750016 LH R15,DCBBLKSI GET BLOCK SIZE 70800016 LA R14,401 GET BTAM BUFFER SIZE + 1 70850016 CR R14,R15 IS INPUT RECORD TOO LARGE 70900016 BH LWRSKIP3 GO TO NORMAL EXIT 70950016 * ERROR - BLOCK TOO BIG 71000016 MVI LWRMSOFS+1,LWROFS57 BLKSIZE LIMIT 400 EXCEEDED 71050016 * JOBNAME DDNAME - ERROR MSG 71100016 MVI LWRMSLEN,LWR17 71150016 MVC LWRBRTIT(8),LWRQMNAM MOVE IN JOBNAME, 71200016 MVI LWRBRTIT+8,LWRBLANK AND A BLANK, THEN THE 71250016 MVC LWRBRTIT+9(8),TIOEDDNM DDNAME 71300016 BAL R4,LWRCBLD GO GENERATE MSG 71350016 * 71400016 BAL R4,LWRITER1 SEND ERROR MSG TO REMOTE 000A 71450016 * 71500016 BAL R4,LWRITE0 START OR END OF DATA SET 71550016 * ERROR EXIT 71600016 LA R15,4 SET ABNORMAL END CODE 71650016 B LWRX GO EXIT TO CALLER 000A 71700016 * 71750016 LWRMSGHE L R15,IHKZZSOC PRESET TO PRINTER 000A 71800016 B LWRSETID GO CHECK FOR POSSIBLE NEED 000A 71850016 * TO FLIP WRITE INITIAL BIT000A 71900016 * 71950016 LWRIDPUN DS 0H 'PUNCH' DEVICE REQUESTED 000A 72000016 CLI LWKID,LWKPRINH WAS PREVIOUS DEVICE PRINTER000A 72050016 BNE LWRSETPU NO, GO SET TO PUNCH 000A 72100016 * YES, IT USED TO BE PRINT 000A 72150016 BAL R4,LWRMD80 GO CHECK FOR MULTIDROP 2780000A 72200016 * 000A 72250016 LWRSETPU MVI LWKID,LWKPUNCH SET HEADER TO 'PUNCH' 000A 72300016 B LWRSKIP3 GO TO NORMAL EXIT 000A 72350016 * 000A 72400016 LWRGT24 DS 0H 19018 72407019 CLI LWKID,LWKPRINH WAS LAST CLASS PRINTER? 19018 72414019 BE LWRIDPRT YES, NO SMF RECORD 19018 72421019 L R14,IHKZZSOC NO, PRESET TO PRINTER 19018 72428019 MVC LWKCLASS,0(R14) SET OUTPUT CLASS 19018 72435019 BAL R9,LWRSMF WRITE SMF RECORD 19018 72442019 LWRIDPRT CLI LWKID,LWKPUNCH WAS PREVIOUS DEVICE PUNCH 000A 72450016 BNE LWRSETPR NO, GO SET PRINTER 000A 72500016 * YES, IT USED TO BE PUNCH 000A 72550016 BAL R4,LWRMD80 GO CHECK FOR MULTIDROP 2780000A 72600016 * 000A 72650016 LWRSETPR MVI LWKID,LWKPRINH SET HEADER TO 'PRINTER' 000A 72700016 * 000A 72750016 LWRSKIP3 SR R15,R15 SET NORMAL RETURN CODE 000A 72800016 LWRX L R4,JEDTNMSG+10 SET RETURN ADDRESS 000A 72850016 BR R4 RETURN TO MAIN ROUTINE 000A 72900016 * 72950016 * CONDITIONS AT NORMAL EXIT - 73000016 * LWKSYSCT HAS BEEN BUMPED BY 1, MAXIMUM VALUE IS 25 73050016 * LWKID HAS BEEN SET TO PRINTER, PUNCH, OR USER EXIT 73100016 * LWKCNTRL HAS BEEN SET TO MACHINE, ASA, OR NO CONTROL CHARACTERS 73150016 * 000A 73200016 LWRMD80 TM TDIRSWCH+2,TDIRMCHN IS IT A 2780 000A 73250016 BCR 1,R4 NO, RETURN 000A 73300016 * 000A 73350016 CLI LCBTYPLN,LCBMULPT IS IT A MULTIPOINT LINE 000A 73400016 BCR 7,R4 NO, RETURN 000A 73450016 * IT IS A MULTIPOINT 2780 000A 73500016 * OUTPUT IS TO GO TO A DIFFERENT DEVICE 000A 73550016 NI TDIRSWCH+1,TDIRWRTF SET TO WRITE INITIAL 000A 73600016 BR R4 RETURN AND SET HEADER TO 000A 73650016 * NEW DEVICE 000A 73700016 EJECT 73750016 * ALL DSB/SMB FROM OS Q MANAGER CHAIN 73800016 * HAVE BEEN PROCESSED. 73850016 * CALL OS Q MANAGER TO DELETE CHAIN. 73900016 * 73950016 LWRNODSB DS 0H 74000016 XC LWKSAVE6,LWKSAVE6 ZERO DISCONTINUED QEB A50147 74006021 * IN WORK AREA A50147 74012021 XC TDIRFAST,TDIRFAST ZERO DISCONTINUED QEB A32841 74020020 MVI LWRQMPOP,LWRQMDEL REQUEST 'DELETE' FUNCTION 74050016 * 74100016 LA R1,JEDTQMPA PASS PARAMETERS 74150016 * 74200016 LINK EPLOC=LWRADELE CALL OS Q MANAGER TO DELETE *74250016 THE CHAIN OF SMB/DSB 74300016 * 74350016 SH R15,LWRFOUR TEST RETURN CODE 74400016 BC 2,LWRQM12 I/O ERROR 74450016 * CONTINUE IF NO WORK (CODE=4) 74500016 * OR GOOD (CODE=0) 74550016 LWROFJOB DS 0H 74600016 L R1,4(R6) GET FASTABLE ADDR FROM QEB 74650016 USING FASTAB,R1 74700016 MVI FASTNAME,FASTINAC DELETE FASTABLE ENTRY 74750016 DROP R1 74800016 BAL R14,LWRCLFMR RECORD FASTABLE ON DISC 000A 74850016 * 74900016 BAL R4,LWRITE0 START OR END OF DATA SET 74950016 * 75000016 LWROFJO NI TDIRSWCH,TDIRJOBF TURN OFF JOB SWITCH 75050016 BAL R9,LWRSMF WRITE SMF RECORD 19018 75070019 LR R0,R12 NON-ZERO FOR 'JOB' QEB 75100016 B LWRCPLM3 CALL POOL MANAGER TO RETURN 75150016 * JOB QEB TO POOL 75200016 * 75250016 * READ ERROR Q MANAGER 75300016 LWRQM12 DS 0H 75350016 * 75450016 MVI LWRMSOFS+1,LWROFS67 DISC ERROR Q MANAGER JOBNAME 75500016 MVI LWRMSLEN,LWR8 75550016 MVC LWRBRTIT(8),LWRQMNAM 75600016 BAL R4,LWRCBLD CALL BUILDMSG 75650016 * 75700016 DS 0H SEND MSG TO CENTRAL A50147 75720021 SVC 35 WTO A50147 75740021 BAL R4,LWRITE0 START OR END OF DATA SET A50147 75760021 BAL R4,LWRITER1 SEND MSG TO REMOTE A50147 75780021 * AND REMOTE 000A 75800016 B LWROFJOB 75850016 EJECT 75900016 * ACTIVATE TASK WHICH LINKS TO 000A 75950016 * EITHER IEFQMSSS OR IEFQDELE 000A 76000016 * 000A 76050016 LWRCLQM DS 0H 000A 76100016 LA R1,JEDTQMPA GET ADDR OF QMPA 000A 76150016 ST R1,LCBPARM1 PASS ADDR OF QMPA TO FIRST 000A 76200016 * OF A 2 WORD PARLIST 000A 76250016 L R1,LCBDDECB PASS ADDR OF ECB I WILL 000A 76300016 ST R1,LCBPARM2 WAIT ON TO 2ND WORD 000A 76350016 XC 0(4,R1),0(R1) CLEAR MY ECB 000A 76400016 LA R0,LCBPARM1 PASS ADDR OF 2 WORD PARLIST000A 76450016 * TO POST AS COMPLETION 000A 76500016 * CODE 000A 76550016 LA R1,LCBQMECB PASS TO POST ADDR OF ECB 000A 76600016 * IT SHOULD POST 000A 76650016 * POST PUTS X'40' IN FIRST BYTE OF 000A 76700016 * LCBQMECB, PUTS R0 (ADDR OF PARLIST) 000A 76750016 * IN LOW 3 BYTES OF LCBQMECB, AND STARTS 000A 76800016 * TASK CONTAINING IHKQMNGR, WHICH WILL 000A 76850016 * LINK TO EITHER IEFQMSSS OR IEFQDELE. 000A 76900016 POST (1),(0) 000A 76950016 * 000A 77000016 L R1,LCBDDECB GET ADDR OF MY ECB 000A 77050016 L R15,IHKZZDSP 000A 77100016 BALR R14,R15 WAIT IN DISPATCHER 000A 77150016 * 000A 77200016 BR R4 RETURN TO CALLING ROUT 000A 77250016 EJECT 000A 77300016 * SUBROUTINE TO WRITE SMF RECORD 19018 77300919 LWRSMF DS 0H SUBROUTINE TO WRITE SMF 19018 77301819 LR R7,R15 SAVE REG. 15 19018 77302719 USING LWRCVT,R1 19018 77303619 L R1,CVTPTR GET CVT POINTER 19018 77304519 L R1,CVTSMCA GET POINTER TO SMCA 19018 77305419 DROP R1 19018 77306319 LTR R1,R1 IF ZERO, 19018 77307219 BCR 8,R9 SMF NOT IN SYSTEM 19018 77308119 * 19018 77309019 LA R0,LWRSMFSZ GET LENGTH OF SMF RECORD 19018 77309919 BAL R4,LWRGETMA GETMAIN FOR RECORD 19018 77310819 BZ LWRSMFOK CORE AVAIL.,BUILD RECORD 19018 77311719 * NO CORE,SEND ERROR MSG. 19018 77312619 MVC LWRMSOFS+1(13),LWRSMFER SET UP PARMS. 19018 77313519 BAL R4,LWRCBLD GO BUILD MESSAGE 19018 77314419 SVC 35 WTO 19018 77315319 LR R15,R7 GET REG. 15 19018 77316219 BR R9 RETURN 19018 77317119 * 19018 77318019 LWRSMFOK DS 0H 19018 77318919 L R4,LWRWORD GET ADDR. OF GOTTEN CORE 19018 77319819 USING LWSMF,R4 BASE OF SMF DSECT 19018 77320719 LR R15,R7 RESTORE R15 IN CASE 19018 77321619 CLI LWKDS,LWR0 DO WE HAVE ANY DATA SETS 19018 77322519 BE NOSMF NO, NO SMF RECORD A44650 77323421 CLI LWKCLASS,LWR0 DO WE HAVE CLASS 19018 77324319 BNE LWRHVCLS YES, SKIP FOLLOWING 19018 77325219 MVC LWKCLASS,JEDTSOUT+1 IF WE HAVE DATA SETS BUT 19018 77326119 * NO CLASS, FILL IN CLASS 19018 77327019 LWRHVCLS DS 0H 19018 77327919 XC LWSMF(LWRSMFSZ),LWSMF ZERO AREA 19018 77328819 MVI LWSHEAD+1,LWRSMFLG LENGTH OF SMF RECORD 19018 77329719 MVI LWSTYPE,LWR6 TYPE 6 RECORD 19018 77330619 TIME BIN GET TIME AND DATE 19018 77331519 STM R0,R1,LWSTIME STORE TIME AND DATE 19018 77332419 MVC LWSOUT,LWKCLASS OUTPUT CLASS 19018 77333319 MVC LWSWTIME(14),LWKTIME TIME AND DATE 19018 77334219 MVC LWSFORM,TDIRFORM FORM NUMBER 19018 77335119 LA R1,LWKSSYSD GET PTR TO JOBNAME AND ETC. 19018 77335519 MVC LWSSYSID(28),0(R1) SYSID,JOBNAME,TIME,USER DATA 19018 77339619 CLC 0(4,R1),LWRFZERO SHOULD SMF BE DONE 19018 77339919 BE NOSMF NO SKIP SMF PROCESSING 19018 77340219 XC LWKCOUNT(6),LWKCOUNT REINITIALIZE COUNT 19018 77340519 LA R1,LWSHEAD GET ADDRESS OF RECORD 19018 77341419 SMFWTM (1) DO SMF WRITE 19018 77342319 NOSMF EQU * 77342719 LA R0,LWRSMFSZ LENGTH FOR FREEMAIN 19018 77343219 LR R1,R4 ADDRESS FOR FREEMAIN 19018 77344119 FREEMAIN R,LV=(0),A=(1) FREEMAIN SMF RECORD AREA 19018 77345019 LR R15,R7 GET REG. 15 19018 77345919 BR R9 RETURN 19018 77346819 EJECT 19018 77347719 *********************************************************************** 77350016 * 77400016 * CONSTANTS 77450016 * 77500016 *********************************************************************** 77550016 LWRSMBMX DC H'144' MAX LENGTH OF WORK STATION MSGA29491 77570020 DS 0F ALLIGN TO WORD BOUNDARY 000A 77600016 LWRFZERO DC F'0' ZERO CONSTANT 000C 77620018 LWRTEN DC H'10' A47442 77625021 SPACE 2 19018 77630019 LWRSMFER DC X'360B',C'SMF GETMAIN' MSG. FOR SMF ERROR 19018 77640019 * NOTE: THE FOLLOWING HEADER MUST START ON THE SECOND BYTE OF A 19018 77650019 * WORD. IF CONSTANTS MUST BE ADDED WHICH WOULD CHANGE THIS 19018 77660019 * ALIGNMENT, PADDING BYTES MUST BE ADDED. 19018 77670019 * 77700016 * HEADER FOR RJE MESSAGES 77750016 * 77800016 LWRMSGHD DC C'3' KEYBOARD 77850016 DC C'3' NO CONTROL CHARS 77900016 DC C'1' FIXED UNBLOCKED 77950016 DC F'60' LENGTH OF RJE MESSAGES 000A 78000016 * 78050016 * EXTERNAL ADCONS 78100016 * 78150016 LWRADCOM DC A(IHKCACOM) ADDRESS VECTOR TABLE (AVT) 78200016 EXTRN IHKCACOM 78250016 * 78300016 * NON-RESIDENT SUBROUTINES 78350016 * 78400016 LWRADDT2 DC C'IHKCGDT2' DELET QM CHAIN,SCRATCH SOUT000A 78450016 * 000A 78500016 LWRADRMV DC C'IHKCDRMV' SCRATCH DATA SET ROUTINE 78550016 * 78600016 LWRADELE DC C'IEFQDELE' OS Q MANAGER DELETE 78650016 * 78700016 LWRADMDQ DC C'IHKCDMDQ' MESSAGE DEQUEUE FROM DISC 78750016 * 78800016 LWRADRER DC C'IHKABRER' CHECKS FOR EMPTY DATA SET 78850016 * 78900016 * EQUATES 78950016 * 79000016 LWRX80 EQU X'80' 79050016 LWRX10 EQU X'10' 79100016 LWRX40 EQU X'40' 79150016 LWRX02 EQU X'02' 79200016 LWRX04 EQU X'04' 79250016 LWRPOST EQU X'40' POSTS ECB COMPLETE 79300016 LWRQEBRD EQU X'08' BRDCST QEB 79350016 LWRQEBDL EQU X'04' DELAYED MSG QEB 79400016 LWRQEBMS EQU X'80' FIRST BIT OF QEB 79450016 LWRLST87 EQU X'87' ID OF JFCB ADDR IN EXLST OF DCB 79500016 DATAOPEN EQU X'80' DATA SET OPEN FLAG A28929 79510020 DATCLOSE EQU X'7F' DATA SET CLOSED FLAG A28929 79520020 LWR0 EQU 0 NO ADDITION TO MESSAGE 79550016 LWR1 EQU 1 Q MANAGER READS 1 RECORD 79600016 LWR4 EQU 4 4 CHARS ID OF NEW FORM 79650016 LWR6 EQU 6 ADD TO BRDCST HEADER/TRAILER 79700016 LWR16 EQU 16 INDICATES RJENDF 79750016 LWR8 EQU 8 LENGTH OF JOBNAME FOR ERROR 79800016 LWR17 EQU 17 79850016 LWR24 EQU 24 24 CHARS TO ADD TO DISC ERROR 79900016 LWR60 EQU 60 SIZE OF RJE MESSAGES 79950016 LWROFS65 EQU 65 OFFSET OF DISC ERROR JED 80000016 LWROFS13 EQU 13 OFFSET OF LINE ERROR 80050016 LWROFS57 EQU 57 OFFSET BLKSIZE LIMIT 400 EXCEED 80100016 LWROFS71 EQU 71 OFFSET OF FORM CHANGE MSG 80150016 LWROFS68 EQU 68 OFFSET OF DISC ERROR SYSOUT 80200016 LWROFS53 EQU 53 OFFSET OF BRDCST HEADER/TRAILER 80250016 LWROFS54 EQU 54 OFFSET OF OUT OF CORE SPACE 80300016 LWROFS67 EQU 67 OFFSET OF DISC ERROR Q MANAGER 80350016 LWROFS74 EQU 74 OFFSET OF VOL NOT FOUND A47442 80360021 * MESSAGE A47442 80370021 LWRQMRED EQU 4 REQUEST 'READ' FUNCTION 80400016 LWRQMDEL EQU 8 REQUEST Q MANAGER 'DELETE' 80450016 LWRSMBCN EQU X'FE' CONDENSED SMB 80500016 FASTDISA EQU X'00' DISABLE FASTABLE ENTRY 80550016 FASTINAC EQU X'40' INACTIVE FASTABLE ENTRY 80600016 FASTNINN EQU X'08' NOTIFY INFO BIT-FASTJIB 000A 80650016 FASTNINF EQU X'F7' TURNS OFF NOTIFY INFO BIT 000A 80700016 LWRDCBOP EQU X'10' OPEN FLAG IN DCB 80750016 LWRSMFSZ EQU 63 GETMAIN SIZE FOR SMF 19018 80790019 LWRSMFLG EQU 61 ACTUAL SIZE FOR SMF 19018 80810019 LWRESID EQU 14 DISP OF RESIDUAL COUNT 80850016 LWRBLANK EQU C' ' BLANK 80900016 LWRCHAR1 EQU C'1' IDENTIFIES REMOTE MSG WHEN 000A 80950016 * SAME MSG GOES TO CENTRAL 000A 81000016 * AND REMOTE 000A 81050016 LWRDSB15 EQU X'15' TABLE ID FOR A DSB A22275 81070018 EJECT 81100016 LWRDDCB DCB DSORG=PS, DISC DCB IS MOVED FROM HERE *81150016 MACRF=RP, TO WORKAREA POINTED TO BY R8,*81200016 EODAD=LWREODAD, SET BY A(DCB) FROM DISC DECB,*81250016 SYNAD=LWRSYNAD, POINTED TO BY LCB. *81300016 DDNAME=MAR2668A 000A*81350016 DDNAME IS REPLACED BY ONE FROM DSB 81400016 * 81450016 LWRTTR DC X'00000001' TTR OF FIRST BLOCK 81500016 LWRFOUR DC H'4' CONSTANT FOUR 81550016 LWRH24 DC H'25' LIMIT OF SYSOUT CLASSES 81600016 * 81650016 * EXECUTED INSTRUCTIONS 81700016 * 81750016 LWRMVTIO MVC 24(0,R1),TIOELNGH MOVE TIOT ENTRY FROM DSB TO 81800016 * NEW TIOT AREA 81850016 LWRXC XC 0(0,R1),0(R1) CLEAR GETMAIN AREA OF NEW TIOT 81900016 * TO ALL ZERO. THIS SETS THE 81950016 * LAST WORD OF NEW TIOT TO ZERO 82000016 * AS AN END SENTINEL 82050016 LWRSMBMT MVC 0(0,R6),0(R8) MOVE SMB (TEXT/BLANKS) TO BUF 82100016 * 82150016 * 82200016 * MESSAGE CONSTANTS 82250016 * 82300016 LWRBRDL2 DC C'FOLLOW' 82350016 LWRBRDL3 DC C'END ' 82400016 EJECT 82450016 *********************************************************************** 82500016 * 82550016 * DSECTS 82600016 * 82650016 *********************************************************************** 82700016 LWSMF DSECT 19018 82702019 CNOP 2,4 19018 82704019 LWSHEAD DC X'003D' LENGTH OF RECORD 19018 82706019 LWSZERO DC XL3'00' RESERVED BYTES 19018 82708019 LWSTYPE DC X'06' RECORD TYPE 19018 82710019 LWSTIME DS XL8 TIME AND DATE 19018 82712019 LWSSYSID DS CL4 SYSTEM ID 19018 82714019 LWSNAME DS CL8 JOBNAME 19018 82716019 LWSRTIME DS XL8 READER START TIME + DATE 19018 82718019 LWSUSER DS CL8 USER INFORMATION 19018 82720019 LWSOUT DS CL1 OUTPUT WRITER CLASS 19018 82722019 LWSWTIME DS XL8 WRITER START TIME + DATE 19018 82724019 LWSCOUNT DS XL4 RECORD COUNT 19018 82726019 LWSTATUS DS XL1 ERROR STATUS 19018 82728019 LWSDS DS XL1 DATA SET COUNT 19018 82730019 LWSFORM DS CL4 FORM NUMBER 19018 82732019 EJECT 19018 82734019 IECTDECB 82750016 EJECT 82800016 DCBD DSORG=(BS,BX),DEVD=DA 82850016 EJECT 82900016 IHKDSECT TDIR,,FASTAB,,LCB,AVT 82950016 * 83000016 *********************************************************************** 83050016 LWRTCB DSECT 83100016 DS 12C 83150016 TCBTIO DS F ADDR OF TIOT 83200016 EJECT 83250016 LWRCVT DSECT 83300016 CVT 83350016 EJECT 83400016 LWRUCB DSECT 83450016 IEFUCBOB 83500016 IECTDEBX A32869 83520020 EJECT 83550016 *********************************************************************** 83600016 * 83650016 LWRWORD EQU LCBPARM2 TEMPORARY STORAGE 83700016 * 83750016 * PARAMETER LIST FOR IHKABRER 83800016 * 83850016 LWRNTIOT EQU LCBPARM1 ADDR OF DSB A47442 83900021 LWRADDCB EQU LCBPARM2 ADDR OF SYSOUT DCB, FROM R8 83950016 LWRADTDE EQU LCBPARM3 ADDR OF TDIR A32869 83970021 * 84000016 * PARAMETER LIST FOR RJE QUEUE MANAGER 84050016 * 84100016 LWRQMGTD EQU LCBPARM1 ADDR OF TERMINAL DIRECTORY 84150016 * ENTRY 84200016 LWRQMG0 EQU LCBPARM2 REQUESTS 'DEQUEUE',VALUE ZERO 84250016 * 84300016 * PARAMETER LIST FOR IHKCCPLM 84350016 * 84400016 LWRPLM1 EQU LCBPARM1 '0'-MSG, 'NON-0'-JOB 84450016 LWRPLM2 EQU LCBPARM2 '0'-RETRUEVE, 'BLOCK ADDRESS'- 84500016 * RETURN BLOCK 84550016 * 84600016 * PARAMETER LIST FOR IHKCGDT2 84650016 * 84700016 LWRDT2PA EQU LCBPARM1 DC X'80', DC XL3'000000' 84750016 * JED ADDRESS 84800016 LWRDT2P2 EQU LCBPARM2 A(IHKCACOM), AVT ADDRESS 000A 84850016 EJECT 84900016 LWKWORK DSECT 84950016 * 000A 85000016 * THE FOLLOWING WORKAREA IS USED BY BOTH IHKABLWR AND IHKABORT. 000C 85050018 * IF IT SHOULD BECOME NECESSARY TO MODIFY THE WORKAREA FORMAT, ANY 000A 85100016 * DSECT CHANGES SHOULD BE MADE SIMULTANEOUSLY TO BOTH ROUTINES. 000A 85150016 * 000A 85200016 * THE WORKAREA IS GETMAINED BY IHKABLWR WHEN THE LINE SCHEDULER, 000A 85250016 * IHKABLST, CALLS ON IHKABLWR TO PROCESS OUTPUT FOR A PARTICULAR 000A 85300016 * TERMINAL. IT IS FREEMAINED WHEN IHKABLWR RETURNS TO IHKABLST. 000A 85350016 * 000A 85400016 * IF NECESSARY TO CHANGE THE NUMBER OF BYTES IN THE WORKAREA, 000A 85450016 * MAKE CORRESPONDING CHANGES TO THE DSECT OF BOTH ROUTINES AND 000A 85500016 * CHANGE, IN IHKABLWR, THE VALUE EQUATED TO THE TAG, LWRSIZE. 000A 85550016 * 000A 85600016 * 85650016 * PARAMETER LIST FOR JEDTABLE MANAGER,IHKCDJMR 85700016 * 85750016 LWKADFST DS CL4 ADDR OF FASTABLE ENTRY 85800016 LWKADJED DS CL4 ADDR OF CORE JED ENTRY 85850016 * 85900016 * PARAMETER LIST FOR SCRATCHER, IHKCDRMV 85950016 * 86000016 LWKADDSB DS CL4 ADDR OF DSB POINTING TO DATA 86050016 * SET TO BE SCRATCHED 86100016 LWKADQMP DS CL4 ADDR OF Q MANAGER PARAMETER 86150016 * AREA 86200016 * 86250016 * PARAMETER LIST FOR MESSAGE DISC DEQUEUE. 86300016 * IHKCDMDQ 86350016 * 86400016 LWKADCBS DS CL4 A(IHKCDCBS) 86450016 * ADDR OF RESIDENT DCBS 86500016 LWKADISP DS CL4 V(IHKAADSP) 86550016 * ADDR OF DISPATCHER 86600016 * FIRST BIT- 86650016 * '1'-MSG 86700016 * '0'-BRDCST 86750016 LWRGETMS EQU X'80' REQUEST MSG FROM IHKCDMDQ 86800016 LWRGETBR EQU X'7F' REQUEST BRDCST FROM IHKCDMDQ 86850016 * 86900016 LWKMDQK DS CL4 CONTROL VALUE 86950016 LWKMDQIO DS CL4 ADDR OF 60 BYTE I/O AREA 87000016 LWKMDQTD DS CL4 ADDR OF TERMINAL DIRECTORY 87050016 * ENTRY 87100016 * FIRST BIT- 87150016 * '1'-DO NOT DELETE TEXT 87200016 * '0'-DELETE TEXT 87250016 LWKTIOTO DS CL4 ADDR OF OLD TIOT 87300016 LWKTIOTN DS CL4 ADDR OF NEW TIOT IN GETMAIN 87350016 LWKTIOTL DS CL4 NO. BYTES IN TIOT GETMAIN AREA 87400016 LWKADTCB DS CL4 ADDR OF TCB 87450016 LWKSYSCT DS C COUNTER OF 24 SYSOUT CLASSES 87500016 LWKID DS C IDENTIFIES DESTINATION DEVICE 87550016 LWKPRINH EQU C'1' PRINTER 87600016 LWKPUNCH EQU C'2' PUNCH 87650016 LWKEYBDH EQU C'3' KEYBOARD 87700016 LWKUSEXH EQU C'4' USER EXIT 87750016 LWKCNTRL DS C IDENTIFIES CONTROL CHARACTERS 87800016 LWKMACHH EQU C'1' MACHINE CODE 87850016 LWKASACH EQU C'2' ASA 87900016 LWKNONEH EQU C'3' NONE 87950016 LWKRECFM DS C RECORD FORMAT 88000016 LWKFXUBH EQU C'1' FIXED UNBLOCKED 88050016 LWKVAUBH EQU C'3' VARIABLE UNBLOCKED 88100016 LWKFXBLH EQU C'2' FIXED BLOCKED 88150016 LWKVARBH EQU C'4' VARIABLE BLOCKED 88200016 LWKUNDFH EQU C'5' UNDEFINED 88250016 LWKRECSZ DS CL4 LRECL OF FIXED BLOCKS 88300016 * ZERO OF NOT FIXED 88350016 LWKTIME DS XL8 TIME AND DATE 19018 88356019 LWKCOUNT DS XL4 SYSOUT COUNT 19018 88362019 LWKSTATS DS XL1 ERROR STATUS 19018 88368019 LWKIOERR EQU X'04' ERROR INDICATOR 19018 88374019 LWKDS DS XL1 DATA SET COUNT 19018 88380019 LWKCLASS DS CL1 SYSOUT CLASS 19018 88386019 LWKPAD DS XL1 UNUSED, NEEDED TO PAD 19018 88392019 LWKTTR DS CL4 TTR OF LAST BLOCK OF SYSOUT 88400016 * DATA JUST READ 88450016 LWKSAVE DS 11CL4 SAVE AREA USED BY IHKABLWT 88500016 LWKSAVE6 DS CL4 HOLDS REG 6 DURING SMB HANDLER 88600016 LWKSTABF DS CL4 ADDR OF SYSOUT BUFFER 88650016 LWKENDBF DS CL4 ADDR OF 1ST BYTE BEYOND 88700016 * SYSOUT BUFFER 88750016 LWKDTTR DS CL4 TTR TO START READING 88900016 LWKBFEND DS CL4 ABORT BUFFER END ADDRESS 000C 88910018 LWKORTSV DS CL12 IHKABORT BUFFER MGNMT INFO 000C 88920018 LWRLIST DS CL4 X'87',AL3(0) ADDR OF JFCB 88950016 * IN IHKABRER 89000016 * PARAMETER LIST FOR IHKCBLDM 89050016 LWRBLDM DS CL4 X'80000000' MESSAGE IS NOT TO BE ENQUEUED 89100016 LWRMSOFS DS CL2 MESSAGE OFFSET 89150016 LWRMSLEN DS C NO. CHARS TO BE ADDED 89200016 LWRBRTIT DS 25C CHARS TO BE ADDED 89250016 LWKSSYSD DS CL28 SAVE FOR JOBNAME AND ETC. 19018 89270019 LWKBIN DS CL144 SMB WORKAREA A28214 89310019 * 89350016 * THE JED TABLE, WITH ITS Q MANAGER PARAMETER AREA, IS READ INTO THE 89400016 * WORKAREA. THE DSB/SMB IS ALSO READ INTO THIS AREA, 89450016 * OVERLAPPING THE JED TABLE BY 4 BYTES. 89500016 * 89550016 LWKH DS 0H 89600016 DS CL2 TO CAUSE QMPA TO BE ON A 89650016 * WORD BOUNDARY, JED MUST BEGIN 89700016 * ON A HALF, NOT FULL WORD. 89750016 JEDTNMSG DS CL25 TEMPORARY STORAGE 89800016 JEDTSOUT DS CL25 SYSOUT CLASSES (ORIGINAL) 89850016 LWRONE EQU 1 INITIAL SYSOUT CLASS POINTER 89900016 JEDTQMPA DS 0CL36 Q MANAGER PARAMETER AREA 89950016 LWRQMNAM DS CL8 JOB NAME 90000016 LWRQMCAN EQU LWRQMNAM ECB ADDR IN SELECTED JOB Q 90050016 LWRQMPEB EQU LWRQMNAM+4 LINKORS ECB MUST = 0 90100016 LWRQMPOP DS CL1 FUNCTION CODE PARAMETER 90150016 * 90200016 LWRQMFLT DS CL2 1ST LOGICAL TRACK ASSIGNED 90250016 * TO JOB 90300016 LWRQMTST DS CL1 NO. RECORDS USED IN LOGICAL 90350016 * TRACK 90400016 LWRQMTLN DS CL2 RELATIVE ADDRESS OF NEXT 90450016 * LOGICAL TRACK 90500016 LWRQMNOT DS CL1 NO. LOGICAL TRACKS ASSIGNED 90550016 * TO JOB 90600016 LWRQMTPY DS CL1 JOB TYPE 90650016 LWRQMSTA DS CL1 JOB STATUS 90700016 * '0'-READY 90750016 * '1'-CANCEL 90800016 * '2'-PRIORITY CHANGE 90850016 * '4'-JOB ENQUEUED 90900016 LWRQMPRI DS CL1 JOB PRIORITY 90950016 LWRQMLNK DS CL2 RELATIVE ADDRESS OF NEXT 91000016 * Q ENTRY 91050016 LWRQMTID DS CL2 Q ENTRY IDENTIFICATION 91100016 DS CL2 91150016 LWRQMWTQ DS CL4 COUNT + ADDR PTR FOR TRACK 91200016 * STACKING 91250016 LWRQMELA DS CL4 ADDRESS USERS ECB/IOB LC 91300016 LWRQMPCL DS CL4 ADDRESS OF EXTERNAL PARAMETER 91350016 LWRQMPCM EQU LWRQMPCL NUMBER OF RECORDS TO ASSIGN 91400016 LWRQMPNC EQU LWRQMPCL NUMBER OF RECORDS TO READ/WRITE 91450016 JEDTQMPE DS 0CL8 EXTERNAL QMPA 91500016 LWRQMPCA DS CL4 BUFFER ADDRESS 91550016 LWRQMPEX DS CL4 TTR FOR READ 91600016 JEDTTTR0 DS CL3 TTR OF THIS DSB/SMB 91650016 JEDTTYPE DS C TABLE ID 91700016 * 91750016 * END OF JEDTABLE 91800016 * 91850016 ORG JEDTTTR0 SMB/DSB OVERLAPS JED 91900016 SMBDSKAD DS CL3 TTR OF THIS DSB/SMB 91950016 SMBIDENT DS C TABLE ID 92000016 SMBNEXT DS CL4 TTR OF NEXT DSB/SMB 92050016 SMBDUMMY DS CL4 TTR OF DUMMY SMB ALLOCATED OR 92100016 * ZERO IF NOT LAST SMB FOR 92150016 * THAT STEP 92200016 SMBNABPT DS CL2 RELATIVE PTR TO NEXT AVAIL BYTE 92250016 SMBMSGLN DS CL2 LENGTH OF MESSAGE, OR ZERO IF 92300016 * NO MORE MSGS IN THE BLOCK, 92350016 * OR EACH BIT=1 TO INDICATE 92400016 * THAT A DATA SET FOLLOWS 92450016 LWRDSBFF EQU X'FF' 'FF' INDICATES ACTIVE DSB 92500016 LWRDSB00 EQU X'00' '00' INDICATES SCRATCHED DSB 92550016 TIOELNGH DS C LENGTH OF DD ENTRY 92600016 TIOESTTA DS C STATUS A 92650016 TIOERLOC DS CL2 POOL LOCATION 92700016 TIOEDDNM DS CL8 DDNAME 92750016 TIOEJFCB DS CL3 TTR OF JFCB 92800016 TIOESTTC DS C STATUS C 92850016 TIOESTTB DS C STATUS B (REPEATED) 92900016 TIOEFSRT DS CL3 UCB POINTER (REPEATED) 92950016 * 93000016 ORG SMBMSGLN+1 93050016 SMBMESAG DS CL160 VARIABLE LENGTH MESSAGE 000C 93100018 SMBEND DS C 93150016 LWRSIZE EQU SMBEND-LWKWORK+1 SIZE OF GETMAIN WORKAREA A28214 93200019 END 93250016 ./ ADD SSI=01013630,NAME=IHKABORT,SOURCE=0 ORT1 TITLE ' OUTPUT ROUTING AND TRANSMITTING ROUTINE ' 00060018 SPACE 00120018 IHKABORT CSECT 00180018 ENTRY IHKABLWT 00240018 EXTRN IHKADPCK 00300018 EXTRN IHKTRTAB 00360018 * 113400,114600,120600,122400,123000,123600,125400,129600,130200 000D 00410019 * 171600,417600,418200,419400,528600,573000,591600,606000-606600 000D 00460019 * 612000,633600,765600,766200,817200,823200,823800,824400,825000 000D 00510019 *C622400 A35908 00520020 *C192600-193100,790600,791800 A37778 00530020 *A 303100-303200,792360-792440 A53110 00540021 SPACE 2 00560019 *********************************************************************** 00610019 *---------------------------------------------------------------------* 00660019 *********************************************************************** 00710019 *-* *-* 00760019 *-* *-* 00810019 *-* N A M E -- *-* 00860019 *-* *-* 00910019 *-* IHKABORT - OUTPUT ROUTING AND TRANSMITTING MODULE *-* 00960019 *-* *-* 01010019 *-* *-* 01060019 *-* STATUS: CHANGE LEVEL 2, RELEASE 21.7 *-* 01110021 *-* *-* 01160019 *-* *-* 01210019 *-* F U N C T I O N / O P E R A T I O N -- *-* 01260019 *-* *-* 01310019 *-* THE FUNCTIONS OF THIS MODULE ARE AS FOLLOWS - *-* 01360019 *-* *-* 01410019 *-* 1. CONSTRUCT AND TRANSMIT HEADERS CONTAINING CONTROL *-* 01460019 *-* INFORMATION TO CPU WORK STATIONS. TWO TYPES OF HEADERS ARE *-* 01510019 *-* TRANSMITTED TO CPU WORK STATIONS, DATA AND CLOSEDOWN. *-* 01560019 *-* *-* 01610019 *-* A. THE DATA HEADER DESCRIBES THE RJE OUTPUT WHICH WILL BE *-* 01660019 *-* SENT TO THE WORK STATION FOLLOWING THE RECEIPT OF THE *-* 01710019 *-* HEADER. DATA HEADERS ARE TRANSMITTED IN NON-TRANSPARENT *-* 01760019 *-* TEXT MODE AND HAVE THE FOLLOWING FORMAT AND CONTENT -- *-* 01810019 *-* *-* 01860019 *-* ********************************************************** *-* 01910019 *-* *+0 *+1 *+2 *+3 *+4 *+8 *+9 * *-* 01960019 *-* * SOH * DEVICE * CONTROL * RECORD * RECORD * STX * ETX * *-* 02010019 *-* * * TYPE * CHARACTER * FORMAT * SIZE * * * *-* 02060019 *-* * * * * * * * * *-* 02110019 *-* ********************************************************** *-* 02160019 *-* *-* 02210019 *-* WHERE -- *-* 02260019 *-* *-* 02310019 *-* SOH IS THE DATA LINK START OF HEADER CHARACTER *-* 02360019 *-* *-* 02410019 *-* DEVICE TYPE CONTAINS -- *-* 02460019 *-* *-* 02510019 *-* C'1' FOR OUTPUT DESTINED FOR THE WORK STATION PRINTER *-* 02560019 *-* C'2' FOR OUTPUT DESTINED FOR THE WORK STATION PUNCH *-* 02610019 *-* C'3' FOR RJE MESSAGE OUTPUT FOR EITHER THE WORK *-* 02660019 *-* STATION PRINTER/KEYBOARD IF AVAILABLE OR PRINTER *-* 02710019 *-* C'4' FOR OUTPUT SPECIFIED TO BE PROCESSED BY A USER *-* 02760019 *-* EXIT AT THE WORK STATION. *-* 02810019 *-* *-* 02860019 *-* CONTROL CHARACTER INFORMATION -- *-* 02960019 *-* *-* 03010019 *-* C'1' SPECIFIES OUTPUT CONTAINS MACHINE CODE CARRIAGE *-* 03060019 *-* CONTROL CHARACTERS. *-* 03110019 *-* C'2' SPECIFIES OUTPUT CONTAINS ASA CARRIAGE CONTROL *-* 03160019 *-* CHARACTERS. *-* 03210019 *-* C'3' SPECIFIES CARRIAGE CONTROL CHARACTERS ARE NOT *-* 03260019 *-* PART OF THE OUTPUT *-* 03310019 *-* *-* 03360019 *-* RECORD FORMAT INFORMATION -- *-* 03410019 *-* C'1' SPECIFIES OUTPUT AS FIXED/UNBLOCKED *-* 03460019 *-* C'2' SPECIFIES OUTPUT AS FIXED/BLOCKED *-* 03510019 *-* C'3' SPECIFIES OUTPUT AS VARIABLE/UNBLOCKED *-* 03560019 *-* C'4' SPECIFIES OUTPUT AS VARIABLE/BLOCKED *-* 03610019 *-* C'5' SPECIFIES OUTPUT AS UNDEFINED *-* 03660019 *-* *-* 03710019 *-* RECORD SIZE CONTAINS -- *-* 03760019 *-* *-* 03810019 *-* THE LOGICAL RECORD LENGTH IN DECIMAL VALUE OF THE RJE *-* 03860019 *-* OUTPUT WHICH WILL FOLLOW. *-* 03910019 *-* *-* 03960019 *-* STX IS THE DATA LINK CONTROL TEXT STARTING CHARACTER. *-* 04010019 *-* *-* 04060019 *-* ETX IS THE DATA LINK CONTROL TEXT ENDING CHARACTER. *-* 04110019 EJECT 04130021 *-* *-* 04160019 *-* B. THE CLOSEDOWN HEADER IS TRANSMITTED TO THE CPU WORK *-* 04210019 *-* STATIONS WHEN THE CENTRAL OPERATOR ENTERS A STOP COMMAND *-* 04260019 *-* FOR THE RJE TASK. THE HEADER TELLS THE CPU WORK STATION *-* 04310019 *-* THAT RJE ACTIVITY IS BEING TERMINATED AT THE CENTRAL SYSTEM *-* 04360019 *-* AND HAS THE FOLLOWING FORMAT AND CONTENT -- *-* 04410019 *-* *-* 04460019 *-* ******************************** *-* 04510019 *-* * * * * * *-* 04560019 *-* * SOH * CLOSEDOWN * STX * ETX * *-* 04610019 *-* * * INDICATOR * * * *-* 04660019 *-* * * * * * *-* 04710019 *-* ******************************** *-* 04760019 *-* *-* 04810019 *-* WHERE -- *-* 04860019 *-* *-* 04910019 *-* SOH IS THE DATA LINK CONTROL START OF HEADER CHARACTER. *-* 04960019 *-* *-* 05010019 *-* CLOSEDOWN INDICATOR CONTAINS -- *-* 05060019 *-* *-* 05110019 *-* C'5' TO TELL THE CPU WORK STATION THAT THE CENTRAL *-* 05160019 *-* OPERATOR HAS INITIATED CENTRAL CLOSEDOWN. *-* 05210019 *-* *-* 05260019 *-* STX IS THE DATA LINK CONTROL TEXT STARTING CHARACTER. *-* 05310019 *-* *-* 05360019 *-* ETX IS THE DATA LINK CONTROL TEXT ENDING CHARACTER. *-* 05410019 *-* *-* 05460019 *-* *-* 05510019 EJECT 05560019 *-* 2. RJE OUTPUT TRANSMISSION TO CPU WORK STATIONS. *-* 05610019 *-* *-* 05660019 *-* ALL RJE OUTPUT TRANSMISSIONS TO CPU WORK STATIONS ARE *-* 05710019 *-* SENT IN THE TRANSPARENT MODE OF COMMUNICATION. THIS OUTPUT *-* 05760019 *-* CONSISTS OF EITHER MESSAGE OUTPUT OR JOB OUTPUT. THE *-* 05810019 *-* MAXIMUM LENGTH OF OUTPUT TRANSMISSIONS IS 404 BYTES. THIS *-* 05860019 *-* ALLOWS A MAXIMUM OF 400 BYTES OF DATA AND FOUR DATA LINK *-* 05910019 *-* CONTROL CHARACTERS PER TRANSMISSION. *-* 05960019 *-* *-* 06010019 *-* A. MESSAGE OUTPUT IS TRANSMITTED AS FIXED/UNBLOCKED *-* 06060019 *-* DATA AND HAS A RECORD LENGTH OF SIXTY BYTES. *-* 06110019 *-* *-* 06160019 *-* B. JOB OUTPUT MAY CONSIST OF PUNCH, PRINTER, OR USER EXIT *-* 06210019 *-* DATA. PUNCH AND PRINTER OUTPUT PROCESSING VARIES ACCORDING *-* 06260019 *-* TO RECORD FORMAT, THE AVAILIBILITY OF THE COMPRESS/EXPAND *-* 06310019 *-* FACILITY OF THE WORK STATION, AND THE LENGTH OF THE OUTPUT *-* 06360019 *-* RECORD BEING PROCESSED. USER EXIT DATA IS ALWAYS PROCESSED *-* 06410019 *-* AS FOLLOWS. *-* 06460019 *-* *-* 06510019 *-* - USER EXIT OUTPUT PROCESSING - *-* 06560019 *-* *-* 06610019 *-* USER EXIT OUTPUT IS TRANSMITTED IN BLOCKS OF DATA WHERE *-* 06660019 *-* THE BLOCK LENGTH OF THE DATA TRANSMITTED IS DETERMINED *-* 06710019 *-* BY THE DCB LRECL FIELD FOR THE DATA SET. *-* 06760019 *-* *-* 06810019 *-* - PUNCH AND PRINTER OUTPUT PROCESSING - *-* 06860019 *-* *-* 06910019 *-* RECORD LENGTH IS CHECKED AGAINST MAXIMUM DEVICE SIZE *-* 06960019 *-* EIGHTY BYTES IS ALLOWED FOR PUNCHED OUTPUT AND MAXIMUM *-* 07010019 *-* PRINTER SIZE IS CONTAINED IN THE TDIRPRNT FIELD OF THE *-* 07060019 *-* WORK STATION'S TERMINAL DIRECTORY ENTRY. IF THE OUTPUT *-* 07110019 *-* DATA CONTAINS CARRIAGE CONTROL CHARACTERS A RECORD LENGTH *-* 07160019 *-* OF DEVICE SIZE PLUS ONE. IF THE RECORD LENGTH EXCEEDS THAT *-* 07210019 *-* WHICH IS DETERMINED AS ALLOWABLE THE DATA IS TRUNCATED TO *-* 07260019 *-* THE MAXIMUM SIZE FOR THE DEVICE. A RECORD IS TRUNCATED TO *-* 07310019 *-* ALLOWABLE LIMITS REGARDLESS OF WHETHER OR NOT THE WORK *-* 07360019 *-* STATION HAS THE COMPRESS/EXPAND FACILITY. *-* 07410019 *-* *-* 07460019 *-* RECORD FORMAT PROCESSING IS DEPENDENT UPON THE PRESENCE *-* 07510019 *-* OF THE COMPRESS/EXPAND FEATURE AT THE WORK STATION. IF THE *-* 07560019 *-* WORK STATION DOES NOT HAVE COMPRESS/EXPAND CAPABILITY, ALL *-* 07610019 *-* PUNCH AND PRINTER OUTPUT IS TRANSMITTED AS FIXED BLOCKED. *-* 07660019 *-* VARIABLE AND UNDEFINED DATA IS PADDED WITH BLANKS TO THE *-* 07710019 *-* MAXIMUM DEVICE SIZE, BLOCKED USING THIS LENGTH, AND *-* 07760019 *-* TRANSMITTED WHEN THE BUFFER CANNOT HOLD ANOTHER RECORD OF *-* 07810019 *-* THIS LENGTH. THE BLOCKING FACTOR USED FOR FIXED LENGTH *-* 07860019 *-* DATA IS THAT OF THE LOGICAL RECORD IF IT IS NOT GREATER *-* 07910019 *-* THAN THE MAXIMUM DEVICE SIZE. *-* 07960019 *-* *-* 08010019 EJECT 08060019 *-* COMPRESS/EXPAND PROCESSING INVOLVES REMOVING TRAILING *-* 08110019 *-* AND IMBEDDED BLANKS IN PUNCH AND PRINTER OUTPUT. EACH *-* 08160019 *-* COMPRESSED OUTPUT RECORD HAS THE FOLLOWING FORMAT. *-* 08210019 *-* *-* 08260019 *-* *********************************************************** *-* 08310019 *-* * ** * * * * * * * * * *-* 08360019 *-* * TT ** LL * TEXT * BB * LL * TEXT * BB * ... * LL * TEST * *-* 08410019 *-* * ** * * * * * * * * * *-* 08460019 *-* *********************************************************** *-* 08510019 *-* *-* 08560019 *-* WHERE -- *-* 08610019 *-* TT IS THE TOTAL LENGTH OF THE COMPRESSED RECORD *-* 08660019 *-* (INCLUDING THE TT BYTE.) *-* 08710019 *-* *-* 08760019 *-* LL IS THE LENGTH OF THE FOLLOWING TEXT (NOT INCLUDING *-* 08810019 *-* THE LL BYTE). *-* 08860019 *-* *-* 08910019 *-* BB IS THE NUMBER OF BLANKS SUPPRESSED BEFORE THE *-* 08960019 *-* NEXT TEXT AREA OF THE RECORD. *-* 09010019 *-* *-* 09060019 *-* ** NOTE ** *-* 09110019 *-* THERE IS NO BB BYTE COUNT AT THE END OF THE COMPRESSED *-* 09160019 *-* RECORD TO INDICATE THE NUMBER OF TRAILING BLANKS *-* 09210019 *-* SUPPRESSED IN THE RECORD. *-* 09260019 *-* *-* 09310019 *-* OUTPUT DATA IS ALWAYS COMPRESSED IN THE BTAM BUFFER. IF *-* 09360019 *-* THE BUFFER CANNOT HOLD THE MAXIMUM LENGTH RECORD. THE BTAM *-* 09410019 *-* BUFFER IS EMPTY BY WRITING THE DATA TO THE WORK STATION. *-* 09460019 *-* THE RECORD IS THEN COMPRESSED INTO THE EMPTY BUFFER AND *-* 09510019 *-* THE TTR IS SAVED FOR DISCONTINUE PROCESSING. *-* 09560019 *-* *-* 09610019 *-* 3. RJE OUTPUT TRANSMISSION TO 2780 / 2770 WORK STATIONS *-* 09660019 *-* *-* 09710019 *-* RJE OUTPUT TRANSMISSION TO THE 2780/2770 USES BOTH *-* 09760019 *-* THE TRANSPARENT AND NONTRANSPARENT MODE OF BINARY *-* 09810019 *-* SYNCHRONOUS COMMUNICATION. THE TRANSPARENT MODE IS USED *-* 09860019 *-* ONLY TO SEND PUNCH OUTPUT. ALL OTHER OUTPUT, RJE MESSAGE, *-* 09910019 *-* USER EXIT, AND PRINTER IS SENT IN NONTRANSPARENT TEXT MODE. *-* 09960019 *-* THIS OUTPUT IS EDITED PRIOR TO TRANSMISSION. IF ANY DATA *-* 10010019 *-* LINK CONTROL CHARACTERS ARE FOUND IN OUTPUT WHICH IS TO BE *-* 10060019 *-* PRINTED, THEY ARE REPLACED WITH BLANKS. *-* 10110019 *-* *-* 10160019 *-* 4. CONVERSION OF CARRIAGE CONTROL CHARACTERS TO EQUIVALENT *-* 10210019 *-* 2780/2770 CARRIAGE OPERATIONS *-* 10260019 *-* *-* 10310019 *-* MACHINE CODE AND ASA CARRIAGE CONTROL CHARACTERS ARE *-* 10360019 *-* TRANSLATED TO THE PROPER ESCAPE SEQUENCE WHICH PROVIDES *-* 10410019 *-* THE EQUIVALENT CARRIAGE OPERATION ON THE PRINTER *-* 10460019 *-* CHANNEL SKIPS OF NINE THRU TWELVE *-* 10510019 *-* WHICH ARE NOT PROVIDED AS CARRIAGE CONTROL FUNCTIONS WITH *-* 10560019 *-* THE 2780 ESCAPE SEQUENCE DEFAULT TO WRITE AND SPACE ONE ( *-* 10610019 *-* MACHINE CODE) OR SPACE ONE AND WRITE(ASA). CHANNEL SKIPS *-* 10660019 *-* OF 9 THRU 12 ARE RESOLVED FOR THE 2770. SUPPRESS SPACE IS *-* 10710019 *-* NOT SUPPORTED FOR EITHER THE 2780 OR 2770. *-* 10760019 *-* *-* 10860019 *-* DATA SETS NOT CONTAINING CARRIAGE CONTROL CHARACTERS *-* 10910019 *-* ARE PRECEDED WITH AN ESCAPE SEQUENCE TO SKIP TO CHANNEL ONE *-* 10960019 *-* AND THE OUTPUT IS SINGLE SPACED ON THE PRINTER. *-* 11010019 *-* *-* 11060019 *-* STACKER SELECT CARRIAGE CONTROL CHARACTERS FOR PUNCH *-* 11110019 *-* OUTPUT ARE IGNORED. THE 2770 PUNCH MUST BE OUTPUT DEVICE 2 *-* 11160019 *-* *-* 11210019 *-* 5. BLOCKING 2780 OUTPUT *-* 11260019 *-* *-* 11310019 *-* PUNCH OUTPUT IS TRANSMITTED AS FIXED UNBLOCKED 80 *-* 11360019 *-* CHARACTER RECORDS. TRAILING BLANKS ARE REMOVED FROM *-* 11410019 *-* PRINTED OUTPUT AND BLOCKED UP TO SEVEN RECORDS PER *-* 11460019 *-* TRANSMISSION DEPENDING ON WHETHER THE WORK STATION HAS THE *-* 11510019 *-* MULTIPLE RECORD TRANSMISSION FEATURE (MRT). IF THE *-* 11560019 *-* WORK STATION DOES NOT HAVE MRT, TRANSMISSIONS WILL NOT *-* 11610019 *-* CONTAIN MORE THAN TWO RECORDS. IF MRT IS INSTALLED AT THE *-* 11660019 *-* WORK STATION, A MAXIMUM OF SEVEN RECORDS WILL BE SENT PER *-* 11710019 *-* TRANSMISSION IF THE LINE BUFFER CAN HOLD THEM. *-* 11760019 *-* *-* 11810019 *-* 6. BTAM ERROR PROCESSING *-* 11860019 *-* *-* 11910019 *-* UNRECOVERABLE LINE ERRORS ARE PROCESSED BY INVOKING *-* 11960019 *-* RJENDF PROCEDURES. EOT RESPONSES TO WRITE OPERATIONS *-* 12010019 *-* INVOKE DISCONTINUE PROCESSING. IF A CONTENTION SITUATION *-* 12060019 *-* OCCURS WHILE BIDDING FOR THE LINE, INTERNAL DISCONTINUE *-* 12110019 *-* PROCEDURES ARE INVOKED. *-* 12160019 *-* *-* 12210019 *-* *-* 12260019 *-* *-* 12310019 *-* E N T R Y P O I N T -- *-* 12360019 *-* *-* 12410019 *-* IHKABLWT IS THE ENTRY POINT ASSIGNED TO THIS MODULE. IT *-* 12460019 *-* IS CALLED BY IHKCHLWR (MFT ENVIRONMENT) AND IHKABLWR (MVT *-* 12510019 *-* ENVIRONMENT). *-* 12560019 *-* *-* 12610019 *-* *-* 12660019 *-* I N P U T -- *-* 12710019 *-* *-* 12760019 *-* LCBPARM1 POSITIVE - LOGICAL RECORDS OF JOB OUTPUT OR AN RJE *-* 12810019 *-* MESSAGE TO BE SENT TO THE WORK STATION. *-* 12860019 *-* LCBPARM1 NEGATIVE - TRANSMIT CLOSE DOWN HEADER TO CPU *-* 12910019 *-* WORK STATIONS. *-* 12960019 *-* LCBPARM1 ZERO - INSURE LINE BUFFER EMPTY AND PREPARE TO *-* 13010019 *-* PROCESS HEADER REQUIREMENTS. *-* 13060019 EJECT 13110021 *-* O U T P U T -- *-* 13210019 *-* *-* 13260019 *-* CONTENTS OF LINE BUFFER TRANSMITTED TO THE WORK STATION. *-* 13310019 *-* *-* 13360021 *-* E X T E R N A L R O U T I N E S -- *-* 13410019 *-* *-* 13460019 *-* IHKCHDSP- TO WAIT FOR LINE I/O COMPLETION. *-* 13510019 *-* IHKCHPCK- TO COMPRESS OUTPUT RECORDS FOR TRANSMISSION *-* 13560019 *-* TO CPU WORK STATIONS WITH THIS CAPABILITY. *-* 13610019 *-* *-* 13660019 *-* *-* 13710019 *-* E X I T S -- *-* 13760019 *-* *-* 13810019 *-* NORMAL- RETURN TO THE LWR MODULE WITH REG. 15 CONTAINING *-* 13860019 *-* A ZERO RETURN CODE *-* 13910019 *-* ERROR- RETURN TO THE LWR MODULE WITH REG. 15 CONTAINING *-* 13960019 *-* A FOUR RETURN CODE AND LCBPARM1 CONTAINING ONE OF *-* 14010019 *-* THE FOLLOWING VALUES. *-* 14060019 *-* 1. LCBPARM1 POSITIVE- LINE FAILURE *-* 14110019 *-* 2. LCBPARM1 NEGATIVE- DISCONTINUE *-* 14160019 *-* 3. LCBPARM1 ZERO- CONTENTION *-* 14210019 *-* *-* 14260019 *-* *-* 14310019 *-* T A B L E S / W O R K A R E A S *-* 14360019 *-* *-* 14410019 *-* LINE CONTROL BLOCK- LINE DISCRIPTION AND PARAMETER LIST *-* 14460019 *-* TERMINAL DIRECTORY ENTRY- WORK STATION DESCRIPTION AND *-* 14510019 *-* STATUS *-* 14560019 *-* IHKTRTAB- TRANSLATE TABLE FOR 2780/2770 PRINTER OUTPUT EDIT *-* 14610019 *-* LINE DECB- DETERMINE WRITE OPERATION COMPLETION STATUS *-* 14660019 *-* LWR/LWT WORK AREA- OUTPUT DESCRIPTION AND REENTRANT *-* 14710019 *-* WORK AREA *-* 14760019 *-* BTAM OUTPUT BUFFER- GATHER OUTPUT FOR TRANSMISSION *-* 14810019 *-* *-* 14860019 *-* *-* 14910019 *-* A T T R I B U T E S -- *-* 14960019 *-* *-* 15010019 *-* RESIDENT AND SO-SO REENTRANT *-* 15060019 *-* *-* 15110019 *-* *-* 15160019 *-* N O T E S -- *-* 15210019 *-* *-* 15260019 *-* THIS MODULE APPLICABLE TO RELEASE 18 AND ABOVE. *-* 15310019 *-* EXECUTION OF THIS MODULE DEPENDS UPON AN INTERNAL CHARACTER *-* 15360019 *-* SET COMPATIBLE TO THAT DURING ASSEMBLY. *-* 15410021 *-* *-* 15610019 *-*******************************************************************-* 15660019 *---------------------------------------------------------------------* 15710019 *********************************************************************** 15760019 EJECT 15810019 *********************************************************************** 15860019 *---------------------------------------------------------------------* 15910019 *-*******************************************************************-* 15960019 *-* *-* 16010019 *-* S Y M B O L I C R E G I S T E R U S A G E *-* 16060019 *-* *-* 16110019 *-* *-* 16160019 *-*******************************************************************-* 16210019 *---------------------------------------------------------------------* 16260019 *********************************************************************** 16310019 SPACE 2 16360019 ZIP EQU 0 GENERAL WORK REGISTER 16410019 SPACE 16460019 PAR EQU 1 PARAMETER LIST ADDRESS FOR LINKAGE 16510019 * AND LINE DECB BASE (DSECT) 16560019 LCB EQU 2 LINE CONTROL BLOCK BASE (DSECT) 16610019 SPACE 16660019 TDE EQU 3 TERMINAL DIRECTORY ENTRY BASE (DSECT 16710019 SPACE 16760019 LNK EQU 4 INTERNAL BRANCH REGISTER 16810019 SPACE 16860019 EWA EQU 5 EMITTOR WORK AREA BASE (DSECT) 16910019 SPACE 16960019 LNG EQU 6 RECORD LENGTH PASSED IN LCB 17010019 SPACE 17060019 RAD EQU 7 RECORD ADDRESS PASSED IN LCB AND 17110019 * - OVERFLOW BUFFER ADDRESS 17160019 SPACE 17210019 CBA EQU 8 CURRENT FREE BUFFER AREA ADDRESS 17260019 SPACE 17310019 CNT EQU 9 BUFFER RECORD COUNT 17360019 SPACE 17410019 LK2 EQU 9 INTERNAL BRANCH REGISTER 17460019 SPACE 17510019 MRL EQU 10 MAXIMUM RECORD LENGTH 17560019 SPACE 17610019 BSA EQU 11 BUFFER START ADDRESS 17660019 SPACE 17710019 BAS EQU 12 MODULE BASE ADDRESS 17760019 SPACE 17810019 SAV EQU 13 MODULE SAVE AREA ADDRESS 17860019 SPACE 17910019 BAC EQU 14 RETURN LINKAGE AND WORK REG 17960019 SPACE 18010019 GO EQU 15 ENTRY LINKAGE, RETURN CODE, AND 18060019 * - WORK REG 18110019 EJECT 18160019 *********************************************************************** 18210019 *---------------------------------------------------------------------* 18260019 *-*******************************************************************-* 18310019 *-* *-* 18360019 *-* S Y M B O L I C D I S P L A C E M E N T S , *-* 18410019 *-* V A L U E S , AND L E N G T H S *-* 18460019 *-* *-* 18510019 *-*******************************************************************-* 18560019 *---------------------------------------------------------------------* 18610019 *********************************************************************** 18660019 SPACE 2 18710019 ZERO EQU 0 DISPLACEMENT, LENGTH AND VALUE 18760019 ONE EQU 1 DISPLACEMENT, LENGTH AND VALUE 18810019 TWO EQU 2 DISPLACEMENT, LENGTH AND VALUE 18860019 TRE EQU 3 DISPLACEMENT AND LENGTH 18910019 FOR EQU 4 DISPLACEMENT, LENGTH AND VALUE 18960019 SEV EQU 7 VALUE 19010019 ATE EQU 8 LENGTH 19060019 TWLV EQU 12 DISPLACEMENT 19110019 RJENDF EQU 13 VALUE FOR BTAM LINE ERROR INDICATOR 19160019 FIFTEEN EQU 15 DISPLACEMENT FACTOR 000D 19210019 TOT124 EQU 124 2770 BUFFER SIZE A37778 19260020 TOT252 EQU 252 2770 EXTENDED BUFFER SIZE A37778 19310020 BLANK EQU X'40' BLANK FOR ALL WIPE OUTS 000D 19360019 QMPA EQU 48 DISPLACEMENT OF THE LINE BUFFER FROM LCBBUFER 19410019 STY EQU 60 DISPLACEMENT 19460019 ATY EQU 80 DISPLACEMENT 19510019 L80 EQU 80 19560019 PUNLNG EQU 81 MAXIMUM PUNCH OUTPUT LENGTH 19610019 L199 EQU 199 LENGTH 19660019 L200 EQU 200 LENGTH 19710019 D202 EQU 202 DISPLACEMENT 19760019 D203 EQU 203 DISPLACEMENT 19810019 D241 EQU 241 DISPLACEMENT FOR ASA CODE TRANSLATION 19860019 SKIPD256 EQU 256 DISPLACEMENT 19910019 L256 EQU 256 LENGTH 19960019 BSIZ EQU 396 LENGTH OF LINE BUFFER LESS DATA LINK CONTROL 20010019 SPACE 20060019 * SHIFT INSTRUCTION VALUES 20110019 SPACE 20160019 D256 EQU 8 SHIFT VALUE TO DIVIDE BY 256 20210019 D24 EQU 24 SHIFT VALUE TO CONVERT HIGH ORDER BYTE TO LOW 20260019 * - ORDER BYTE 20310019 SHIF25 EQU 25 SHIFT VALUE TO REMOVE SKIP INDICATOR IN C.C. 20360019 EJECT 20410021 * OUTPUT DESCRIPTION VALUES 20460019 SPACE 20510019 FU EQU C'1' FIXED UNBLOCKED FORMAT 20560019 FB EQU C'2' FIXED BLOCKED FORMAT 20610019 PUNO EQU C'2' PUNCH OUTPUT 20660019 MO EQU C'3' MESSAGE OUTPUT 20710019 UXO EQU C'4' USER EXIT OUTPUT 20760019 MC EQU C'1' DATA CONTAINS MACHINE CODE CARRIAGE CONTROL 20810019 ASA EQU C'2' DATA CONTAINS ASA CARRIAGE CONTROL 20860019 NCC EQU C'3' DATA CONTAINS NO CARRIAGE CONTROL CHARACTERS 20910019 SPACE 20960019 * SYMBOLIC CONDITION CODES 21110019 SPACE 21160019 ON EQU 1 BRANCH ON CONDITION ONES 21210019 HI EQU 2 BRANCH ON CONDITION HIGH 21260019 LO EQU 4 BRANCH ON CONDITION LOW 21310019 NE EQU 7 BRANCH ON CONDITION NOT EQUAL 21360019 EQ EQU 8 BRANCH ON CONDITION EQUAL 21410019 SPACE 21460019 * CPU HEADER LENGTHS 21510019 SPACE 21560019 CHDR EQU 3 CPU CLOSEDOWN HEADER LENGTH LESS ONE 21610019 HDRLNG EQU 9 NORMAL CPU HEADER LENGTH LESS ONE 21660019 SPACE 21710019 * BINARY SYNCHRONOUS DATA LINK CONTROL CHARACTERS 21760019 SPACE 21810019 SOH EQU X'01' START OF HEADER CHARACTER 21860019 STX EQU X'02' START OF TEXT CHARACTER 21910019 ETX EQU X'03' END OF TEXT CHARACTER 21960019 US EQU X'1F' UNIT SEPARATOR CHARACTER 22010019 ESC EQU X'27' ESCAPE CHARACTER 22060019 EOT EQU X'37' END OF TRANSMISSION CHARACTER 22110019 NAK EQU X'3D' NEGATIVE ACKNOWLEDGEMENT CHARACTER 22160019 WACK EQU X'6B' WAIT BEFORE ACKNOWLEDGEMENT 000D 22210019 IRS EQU X'1E' RECORD SEPATOR CHARACTER 000D 22260019 TIMEOUT EQU X'01' TIMEOUT BIT IN DECB 000D 22310019 ENQ EQU X'2D' BID FOR LINE CONTROL CHARACTER 000E 26080018 ETB EQU X'26' ETB CHARACTER FOR LINE CONTROL 000D 26085019 TDIRETXO EQU X'08' 26090019 TDIRETXF EQU X'F7' 26095019 EJECT 26097021 SPACE 26100018 * BTAM COMPLETION CODES AND FLAGS 26160018 SPACE 26220018 CONTENT EQU X'10' CONTENTION OCCURRED ON WRITE OPERATION 26280018 IOERR EQU X'41' I/O ERROR OCCURRED 26340018 NORMAL EQU X'7F' NORMAL COMPLETION 26400018 * BTAM DECTYPE FLAGS 000D 26450019 WTI EQU X'02' WRITE INITIAL 000D 26500019 WTIX EQU X'12' WRITE INITIAL TRANSPARENT 000D 26550019 SPACE 26600019 * 2780 COMPONENT SELECTION CHARACTERS 26650019 SPACE 26700019 PRTID EQU C'3' PRINTER SELECTION CHARACTER 26750019 PUNID EQU C'4' PUNCH SELECTION CHARACTER 26800019 DC1 EQU X'11' 2770 PRINTER SELECTION CHARACTER000D 26850019 DC2 EQU X'12' 2770 PUNCH SELECTION CHARACTER 000D 26900019 SPACE 26950019 * MACHINE CODE MASKS AND COMMAND CODES 27000019 CONE EQU X'F1' SKIP TO CHANNEL ONE 000D 27050019 SPACE 27100019 IMMEDOP EQU X'03' MASK USED TO TEST FOR AN IMMEDIATE OPERATION 27150019 SKIPOPR EQU X'80' MASK USED TO TEST FOR A SKIP OPERATION 27200019 WRTSP1 EQU X'09' WRITE AND SINGLE SPACE COMMAND CODE 27250019 WRTSP2 EQU X'11' WRITE AND DOUBLE SPACE COMMAND CODE 27300019 WRTSP3 EQU X'19' WRITE AND TRIPLE SPACE COMMAND CODE 27350019 SPACE 27400019 * SELECTED ASA CARRIAGE CONTROL CHARACTERS 27450019 SPACE 27500019 F0 EQU C'0' DOUBLE SPACE AND WRITE CARRIAGE CONTROL 27550019 F8 EQU C'8' SKIP TO CHANNEL 8 AND WRITE CARRIAGE CONTROL 27600019 ASTIS EQU C'-' TRIPLE SPACE AND WRITE CARRIAGE CONTROL 27650019 ABLE EQU C'A' 000D 27700019 CHARB EQU C'B' SKIP TO CHANNEL ELEVEN 000D 27750019 CHARC EQU C'C' SKIP TO CHANNEL 12 000D 27800019 SPACE 27850019 * TEMPORARY DSECT RELATED MASKS 27900019 SPACE 27950019 LCBSWOFF EQU X'00' MASK USED TO SET LCBNSWFL BYTE SWITCHES OFF 28000019 BLNK EQU C' ' 28050019 EJECT 28100019 *********************************************************************** 28150019 *---------------------------------------------------------------------* 28200019 *-*******************************************************************-* 28250019 *-* *-* 28300019 *-* E N T R Y L I N K A G E *-* 28350019 *-* *-* 28400019 *-*******************************************************************-* 28450019 *---------------------------------------------------------------------* 28500019 *********************************************************************** 28550019 SPACE 2 28600019 IHKABLWT DS 0H **** MODULE ENTRY POINT 28650019 SPACE 28700019 B TWLV(ZIP,GO) BRANCH AROUND MODULE ID 28750019 SPACE 28800019 DC CL8'IHKABORT' MODULE IDENTIFICATION 28850019 SPACE 28900019 * L LCB,ZERO(PAR) GET LINE CONTROL BLOCK (LCB) ADDRESS 28950019 USING LCBDSECT,LCB TELL ASSEMBLER ABOUT LCB DSECT 29000019 SPACE 29050019 * L EWA,LCBWORKA GET EMITTOR WORK AREA ADDRESS FROM 29100019 * - LCB 29150019 USING LWKWORK,EWA TELL ASSEMBLER ABOUT EMITTOR WORK 29200019 * - AREA DSECT 29250019 SPACE 29300019 * L TDE,LCBTDIR GET TERMINAL DIRECTORY ENTRY ADDRESS 29350019 USING TDIREC,TDE TELL ASSEMBLER OF DSECT BASE 29400019 SPACE 29450019 USING IECTDECB,PAR TELL ASSEMBLER OF DSECT BASE 29500019 SPACE 29550019 STM LNK,BAC,LWKSAVE SAVE REGS FOR MICKEY MOUSE INTERFACE 29600019 BALR BAS,ZIP SET UP MODULE ADDRESSABILITY 29650019 SPACE 29700019 USING *,BAS TELL ASSEMBLER OF BASE REG CHOICE 29750019 SPACE 2 29800019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 29850019 * * 29900019 * I N I T I A L I Z E AND R E T R I E V E P A R M S * 29950019 * * 30000019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 30050019 SPACE 30100019 L BSA,LCBBUFER GET LINE BUFFER POINTER LESS QMPA 30150019 LA BSA,QMPA(BSA) STEP PAST QMPA FOR LINE BUFFER ADDR 30200019 TM TDIRSWC,TDIR2770 IS THIS A 2770 000D 30250019 BO BUF2770 YES COMPUTE BUFFER END 000D 30300019 TM TDIRSWCH+2,TDIRMCHN IS THIS A 2780 A53110 30310021 BZ BUF2780 YES - COMPUTE BUFFER END A53110 30320021 LA ZIP,BSIZ(BSA) GET END OF BUFFER ADDRESS FOR 30350019 * - BLOCKING SUBROUTINES USE 30400019 RESUME DS 0H 000D 30450019 ST ZIP,LWKBFEND SAVE BUFFER ENDING ADDRESS 30600018 LM LNG,RAD,LCBPARM1 GET LOGICAL RECORD LENGTH AND ADDR 30660018 SPACE 2 30780018 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 30840018 * * 30900018 * D E T E R M I N E R E A S O N FOR E N T R Y * 30960018 * * 31020018 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 31080018 SPACE 31140018 LM CBA,MRL,LWKORTSV PICK UP BUFFER MANAGEMENT INFO 31200018 LTR LNG,LNG WHY HAS MODULE BEEN ENTERED 31260018 BM HANGITUP CENTRAL CLOSEDOWN - HANG IT UP TILL 31320018 * - NEXT START UP 31380018 SPACE 31440018 BZ SOEOD STARTING NEW OR FINISHED WITH CURRENT 31500018 * - DATA SET, MAKE SURE THAT ALL DATA WAS 31560018 * - TRANSMITTED. 31620018 SPACE 2 31680018 *********************************************************************** 31740018 *---------------------------------------------------------------------* 31800018 *-*******************************************************************-* 31860018 *-* *-* 31920018 *-* P R O C E S S O U T P U T D A T A *-* 31980018 *-* *-* 32040018 *-*******************************************************************-* 32100018 *---------------------------------------------------------------------* 32160018 *********************************************************************** 32220018 SPACE 32280018 TM TDIRSWCH+2,TDIRBUFN IS BUFFER EMPTY 32340018 BO NOSAV NO, DONT SAVE TTR 32400018 SPACE 32460018 MVC TDIRDTTR(FOR),LWKTTR SAVE CURRENT TTR FOR POSSIBLE 32520018 * - DISCONTINUE 32580018 OI TDIRSWCH+2,TDIRBUFN MARK BUFFER NOT EMPTY 32640018 SPACE 32700018 NOSAV DS 0H **** DEFINE TAG 32760018 TM TDIRSWCH+2,TDIRHDRN IS HEADER REQUIRED 32820018 BO NOHEAD NO, GO PROCESS OUTPUT 32880018 SPACE 32940018 OI TDIRSWCH+2,TDIRHDRN INDICATE HEADER PROCESSED 33000018 TM TDIRSWCH+2,TDIRMCHN IS THIS A CPU WORK STATION 33060018 BZ HEAD2780 NO, GO PROCESS 2780 HEADER RQ'MENTS 33120018 EJECT 33180018 SPACE 2 33240018 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 33300018 * * 33360018 * P R O C E S S C P U H E A D E R * 33420018 * * 33480018 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 33540018 SPACE 33600018 LA CBA,HDRLNG(BSA) GET LENGTH OF HEADER 33660018 MVI ZERO(BSA),SOH PLACE SOH IN LINE BUFFER 33720018 MVC ONE(TRE,BSA),LWKID PLACE DEVICE ID, CONTROL CHARACTER 33780018 * - TYPE AND RECORD FORMAT IN HEADER 33840018 MVI ATE(BSA),STX STANDARDIZE HEADER FORMAT WITH STX 33900018 L MRL,LWKRECSZ GET LENGTH OF USER EXIT DATA 33960018 CLI LWKID,UXO IS THIS USER EXIT OUTPUT 34020018 BE UXHEAD YES, GO PROCESS USER EXIT HEADER 34080018 SPACE 34140018 LR MRL,LNG GET MESSAGE LENGTH FOR CONVERT 34200018 CLI LWKID,MO IS THIS MESSAGE OUTPUT 34260018 BE MSGHEAD YES, GO PROCESS MSG OUTPUT HEADER 34320018 SPACE 34380018 MVI TRE(BSA),FB SET RECORD FORMAT AS FIXED BLOCKED 34440018 BAL LNK,CHKRECSZ DETERMINE BLOCKING SIZE FOR PUNCH OR 34500018 * - PRINTER 34560018 SPACE 34620018 UXHEAD DS 0H **** DEFINE TAG FOR BRANCHING 34680018 MSGHEAD DS 0H **** DEFINE TAG FOR BRANCHING 34740018 SPACE 34800018 CVD MRL,LWKDOUBL CONVERT LENGTH TO PACKED DECIMAL 34860018 UNPK FOR(FOR,BSA),LWKDOUBL(ATE) UNPACK LENGTH IN LINE BUFR 34920018 BAL LNK,OUTWCNT SEND HEADER TO WORK STATION 34980018 SPACE 2 35040018 OI TDIRSWCH+2,TDIRBUFN MARK BUFFER NOT EMPTY 35100018 SPACE 35160018 NOHEAD DS 0H **** DEFINE TAG FOR BRANCHING 35220018 TM TDIRSWCH+2,TDIRMCHN IS THIS A CPU WORK STATION 35280018 BZ NOHEAD80 NO, PROCESS OUTPUT FOR 2780 35340018 SPACE 35400018 * C H E C K C P U O U T P U T T Y P E 35460018 SPACE 35520018 HADHEAD DS 0H **** DEFINE TAG 35580018 CLI LWKID,MO HAVE MESSAGE OUTPUT 35640018 BE SNDMSG YES, HANDLE MESSAGE OUTPUT 35700018 SPACE 35760018 CLI LWKID,UXO DO WE HAVE USER EXIT OUTPUT 35820018 BE HANDUX YES, HANDLE USER EXIT DATA 35880018 EJECT 35940018 SPACE 2 36000018 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 36060018 * * 36120018 * P R O C E S S O U T P U T D E S T I N E D FOR C P U * 36180018 * P R I N T E R OR P U N C H * 36240018 * * 36300018 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 36360018 SPACE 36420018 CR LNG,MRL IS LENGTH LONGER THAN MAX SIZE 36480018 BNH NOTRUNC NO, USE LENGTH PASSED FOR PACKING 36540018 SPACE 36600018 LR LNG,MRL TRUNCATE LENGTH TO MAZIMUM DEVICE 36660018 SPACE 36720018 NOTRUNC DS 0H **** DEFINE TAG FOR BRANCHING 36780018 SPACE 36840018 TM TDIRRB,TDIRPUPN DOES WORK STATION HAVE UNPACK OPTION 36900018 BO PACKIT YES, SUPRESS BLANKS IN OUTPUT 36960018 SPACE 37020018 BCTR LNG,ZIP DECREMENT LENGTH ONE FOR MOVE 37080018 SPACE 37140018 EX LNG,MOVREC MOVE TEXT TO BUFFER 37200018 SPACE 37260018 LA CBA,ZERO(MRL,CBA) UPDATE CURRENT BUFFER LOCATION 37320018 SPACE 37380018 FINUP DS 0H **** DEFINE TAG 37440018 LA GO,ZERO(MRL,CBA) STEP ON RECORD PAST CURRENT LOCATION 37500018 C GO,LWKBFEND IS THIS OUTSIDE LINE BUFFER LIMITS 37560018 BNH EXIT NO, GO BACK AND GET MORE DATA 37620018 SPACE 37680018 B OUTWCTE GO SEND DATA AND RETURN 37740018 SPACE 2 37800018 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 37860018 * * 37920018 * C O M P R E S S / E X P A N D O P T I O N P R O C E S S O R * 37980018 * * 38040018 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 38100018 SPACE 2 38160018 PACKIT DS 0H **** DEFINE TAG FOR BRANCHING 38220018 SPACE 38280018 STM LNG,CBA,LCBPARM1 PASS PARAMETERS TO PACK ROUTINE 38340018 LR PAR,LCB GET PARAMETERS FOR PACK ROUTINE 38400018 L GO,PACKENTY GET ADDRESS OF IHKCHPCK ENTRY ADDR 38460018 L GO,ZERO(GO) GET IHKCHPCK ENTRY POINT 38520018 BALR BAC,GO SUPRESS BLANKS IN RECORD 38580018 SPACE 38640018 SR BAC,BAC CLEAR REGISTER 38700018 IC BAC,ZERO(CBA) GET LENGTH OF PACKED RECORD 38760018 SPACE 38820018 LA CBA,ZERO(BAC,CBA) UPDATE LINE BUFFER ADDRESS 38880018 B FINUP FINISH OUTPUT PROCESSING AND RETURN 38940018 SPACE 2 39060018 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 39120018 * * 39180018 * C P U U S E R E X I T O U T P U T P R O C E S S O R * 39240018 * * 39300018 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 39360018 SPACE 39420018 HANDUX DS 0H **** DEFINE TAG 39480018 LR BAC,LNG GET USER EXIT DATA LENGTH 39540018 SRDL BAC,D256 DIVIDE LENGTH BY 256 FOR MOVE 39600018 SPACE 39660018 LTR BAC,BAC HAVE 256 OR MORE BYTES 39720018 BZ MOVEUX NO SKIP 256 MOVE 39780018 SPACE 39840018 MVC ZERO(L256,CBA),ZERO(RAD) MOVE 256 BYTES OF USER EXIT OUT 39900018 LA CBA,SKIPD256(CBA) UPDATE BUFFER LOCATION 39960018 LA RAD,SKIPD256(RAD) UPDATE RECORD LOCATION 40020018 SPACE 40080018 MOVEUX DS 0H **** DEFINE TAG 40140018 SRL GO,D24 GET REMAINDER IN LOW ORDER BYTE 40200018 LTR GO,GO HAVE ANY REMAINDER 40260018 BZ OUTWCTE NO,SEND WHAT WE HAVE AND RETURN 40320018 SPACE 40380018 EX GO,MOVREC MOVE REMAINDER INTO LINE BUFFER 40440018 LA CBA,ZERO(GO,CBA) UPDATE BUFFER LOCATION 40500018 SPACE 40560018 B OUTWCTE SEND WHAT WE HAVE AND RETURN 40620018 EJECT 40650021 SPACE 2 40680018 *********************************************************************** 40740018 *---------------------------------------------------------------------* 40800018 *-*******************************************************************-* 40860018 *-* *-* 40920018 *-* L I N E B U F F E R C L E A N - U P P R O C E S S O R *-* 40980018 *-* *-* 41040018 *-*******************************************************************-* 41100018 *---------------------------------------------------------------------* 41160018 *********************************************************************** 41220018 SPACE 2 41280018 SOEOD DS 0H **** DEFINE TAG 41340018 NI LCBNSWFL,LCBSWOFF TURN OFF LCB SWITCHES 41400018 NI TDIRSWCH+2,TDIRHDRF SET HEADER REQUIRED FOR NEXT ENTRY 41460018 * - FOR THIS LINE 41520018 OI TDIRSWC,TDIRETXO TURN ON ETX TO BE SENT SWITCH 000D 41550019 TM TDIRSWCH+2,TDIRBUFN IS THERE ANYTHING IN THE BUFFER 41580018 BZ EXIT NO, EXIT TO 41640018 SPACE 41700018 TM TDIRSWCH+2,TDIRMCHN IS WORK STATION CPU 000D 41750019 BO OUTWCTE YES WRITE SEND OUTPUT TO CPU 000D 41800019 SPACE 41850019 B OUTWCNTE NO SEND OUTPUT TO 2780 41900019 SPACE 2 42000019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 42050019 * * 42100019 * P R O C E S S 2 7 8 0 H E A D E R R E Q U I R E M E N T S * 42150019 * * 42200019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 42250019 SPACE 2 42300019 HEAD2780 DS 0H **** DEFINE TAG 42350019 BAL LNK,CHKRECSZ GET MAXIMUM RECORD LENGTH 42400019 TM TDIRSWC,TDIR2770 IS IT A 2770 000D 42450019 BO WEOT YES WRITE AN EOT 000D 42500019 RETWEOT EQU * 000D 42550019 SPACE 42600019 CLI LCBTYPLN,LCBMULPT IS THIS A MULTIPOINT LINE 42650019 BE MULTHEAD YES, SET UP FOR COMPONENT SELECTION 42700019 TM TDIRSWC,TDIR2770 IS THIS A 2770 000D 42750019 BO SELPUN YES SELECT PRINTER OR PUNCH 000D 42800019 SPACE 42850019 CLI LWKID,PUNO HAVE PUNCH OUTPUT 42900019 BE SELPUN YES, SELECT PUNCH WITH ESCAPE SEQ 42950019 * - SEQUENCE BEFORE SENDING OUTPUT 43000019 EJECT 43050021 SKIPPUN DS 0H **** DEFINE TAG 43100019 MVI ZERO(BSA),STX INDICATE START OF TEXT 43150019 LR CBA,BSA INITIALIZE FREE BUFFER AREA ADDRESS 43200019 SR CNT,CNT INITIALIZE BUFFER RECORD COUNT 43250019 SPACE 43300019 CLI LWKCNTRL,NCC DATA CONTAIN OWN CARRIAGE CONTROL 43350019 BNE NOHEAD80 YES, PROCESS INITIAL CARRIAGE CNTRL 43400019 SPACE 43450019 MVC ONE(TRE,CBA),SKIPIT MOVE IN ESCAPE SEQUENCE TO SKIP TO 43500019 * - CHANNEL ONE 43550019 TM TDIRSWC,TDIR2770 IS THIS A 2770 000D 43600019 BZ FORGETIT NO FORGET OVERLAY 000D 43650019 MVI TRE(CBA),IRS OVERLAY US WITH IRS 000D 43700019 FORGETIT DS 0H 000D 43750019 LA CNT,ONE(CNT) UPDATE BUFFER RECORD COUNT 43800019 LA CBA,TRE(CBA) UPDATE FREE BUFFER AREA ADDRESS 43850019 SPACE 2 43900019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 43950019 * * 44000019 * C H E C K FOR P U N C H OR P R I N T E R O U T P U T * 44050019 * * 44100019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 44150019 SPACE 44200019 NOHEAD80 DS 0H **** DEFINE TAG 44250019 CR LNG,MRL DATA LENGTH GREATER THAN DEVICE SIZE 44300019 BNH NOCHANG NO, DO NOT TRUNCATE DATA LENGTH 44350019 SPACE 44400019 LR LNG,MRL TRUNCATE DATA LENGTH TO DEVICE SIZE 44450019 SPACE 44500019 NOCHANG DS 0H **** DEFINE TAG 44550019 CLI LWKID,PUNO HAVE OUTPUT FOR PUNCH 44600019 BE PUNCH80 YES, PROCESS PUNCH OUTPUT 44650019 EJECT 44700019 SPACE 2 44750019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 44800019 * * 44850019 * P R O C E S S 2 7 8 0 P R I N T E R O U T P U T * 44900019 * * 44950019 * S T A R T BY S U P P R E S S I N G * 45000019 * T R A I L I N G B L A N K S IN THE O U T P U T * 45050019 * * 45100019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 45150019 SPACE 45200019 LA GO,ZERO(LNG,RAD) GET END OF DATA ADDRESS 45250019 SPACE 45300019 GOTOIT DS 0H **** DEFINE TAG 45350019 BCTR GO,ZIP GET ADDRESS OF BYTE TO BE CHECKED 45400019 CLI ZERO(GO),BLNK BYTE CONTAIN BLANK CHARACTER 45450019 BNE DUNIT NO, HAVE FOUND LAST NONBLANK - EXIT 45500019 SPACE 45550019 BCT LNG,GOTOIT REDUCE DATA LENGTH AND CHECK NEXT 45600019 * - BYTE IF NOT ALL DATA CHECKED 45650019 SPACE 45700019 LA LNG,ONE NEED AT LEAST ONE DATA CHARACTER 45750019 SPACE 45800019 DUNIT DS 0H **** DEFINE TAG 45850019 BAL LNK,CHKBUF HANDLE BUFFER MANAGEMENT 45900019 SPACE 2 45950019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 46000019 * * 46050019 * N E E D TO P R O C E S S C A R R I A G E C O N T R O L * 46100019 * C H A R A C T E R S IN THE D A T A * 46150019 * * 46200019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 46250019 SPACE 46300019 CLI LWKCNTRL,NCC CONTROL CHAR ABSENT FROM DATA 46350019 BNE CNVTCC NO, CONVERT CARRIAGE CONTROL TO 2780 46400019 * - EQUIVALENT 46450019 SPACE 46500019 BCTR RAD,ZIP STEP BACK RECORD ADDRESS 46550019 EJECT 46570021 SPACE 2 46600019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 46650019 * * 46700019 * P R O C E S S D A T A WITHOUT C A R R I A G E C O N T R O L * 46750019 * * 46800019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 46850019 SPACE 46900019 DEFAULT DS 0H **** DEFINE TAG 46950019 MVC ONE(TWO,CBA),ESCS MOVE IN SINGLE SPACE ESCAPE SEQUENCE 47000019 LA CBA,TRE(CBA) UPDATE FREE BUFFER AREA ADDRESS 47050019 SPACE 47100019 CONTCC DS 0H **** DEFINE TAG 47150019 BCTR LNG,ZIP SET UP LENGTH FOR TRANSLATE FUNCTION 47200019 SPACE 2 47300019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 47350019 * * 47400019 * R E M O V E B I S Y N C H D A T A L I N K C O N T R O L * 47450019 * C H A R A C T E R S FROM P R I N T E R O U T P U T * 47500019 * * 47550019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 47600019 SPACE 47650019 LA RAD,ONE(RAD) STEP UP RECORD ADDRESS BY ONE 47700019 L BAC,TRTABAD GET TRANSLATE TABLE ADDRESS 47750019 EX LNG,TRINST BLANK DATA LINK CONTROL CHARACTERS 47800019 * - IN DATA TO BE TRANSMITTED 47850019 SPACE 47900019 EX LNG,MOVREC MOVE DATA TO LINE BUFFER 47950019 SPACE 48000019 LA CBA,ONE(LNG,CBA) UPDATE FREE BUFFER AREA ADDRESS 48050019 SPACE 48100019 SKIPDATA DS 0H **** DEFINE TAG 48150019 LA CNT,ONE(CNT) UPDATE BUFFER RECORD COUNT 48200019 OI TDIRSWCH+2,TDIRBUFN SET BUFFER NOT EMPTY INDICATOR 48250019 MVI ZERO(CBA),US PLACE END OF RECORD IN LINE BUFFER 48300019 TM TDIRSWC,TDIR2770 IS THIS A 2770 000D 48350019 BZ NOT2770 NO FORGET IRS 000D 48400019 MVI ZERO(CBA),IRS USE IRS INSTEAD OF US 000D 48450019 NOT2770 DS 0H 000D 48500019 SPACE 49140018 CLI LWKID,MO IS THIS RJE MESSAGE OUTPUT 49200018 BE OUTWCNTE YES, XMIT RJE MSG OUTPUT UNBLOCKED 49260018 EJECT 49290021 SPACE 2 49320018 *********************************************************************** 49380018 *---------------------------------------------------------------------* 49440018 *-*******************************************************************-* 49500018 *-* *-* 49560018 *-* R E T U R N L I N K A G E *-* 49620018 *-* *-* 49680018 *-*******************************************************************-* 49740018 *---------------------------------------------------------------------* 49800018 *********************************************************************** 49860018 SPACE 2 49920018 EXIT DS 0H **** DEFINE TAG 49980018 TM TDIRSWC,TDIR2770 TEST FOR 2770 000D 49990019 BO WEOD YES SEND STX-ETX SEQ TO DESELECT 000D 50000019 EXITA EQU * 50010019 SR GO,GO SET ZERO RETURN CODE 50040018 SPACE 50100018 EXITERR DS 0H **** DEFINE TAG 50160018 NI TDIRSWC,TDIRWACF TURN OFF WACK FLAG 000E 50190018 NI TDIRSWC,TDIRETXF TURN OFF END OF TEXT CHAR INDIC 000D 50200019 STM CBA,MRL,LWKORTSV SAVE LINE BUFFER AND DATA INFO 50220018 LM LNK,BAC,LWKSAVE RESTORE IHKABLWR REGS 50280018 BR BAC 50340018 EJECT 50400018 SPACE 2 50460018 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 50520018 * * 50580018 * P R O C E S S C A R R I A G E C O N T R O L * 50640018 * C H A R A C T E R S IN D A T A * 50700018 * * 50760018 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 50820018 SPACE 50880018 CNVTCC DS 0H **** DEFINE TAG 50940018 BAL LNK,DOCNVRT GET ADDRESS OF 2780 EQUIVALENT FOR 51000018 * - ASA OR MACHINE CODE CARRIAGE CNTRL 51060018 BCT LNG,HAVEONE REDUCE RECORD LENGTH BY ONE 51120018 SPACE 51180018 LA LNG,ONE NEED AT LEAST ONE DATA CHARACTER 51240018 SPACE 51300018 HAVEONE DS 0H **** DEFINE TAG 51360018 LTR GO,GO DEFAULT CARRIAGE CONTROL SUFFICIENT 51420018 BZ DEFAULT YES, HANDLE DATA AS NO CARRIAGE 51480018 * - CONTROL CHARACTER PRESENT 51540018 SPACE 51600018 MVI ONE(CBA),ESC 51660018 MVC TWO(ONE,CBA),ZERO(GO) MOVE EQUIVALENT 2780 CARRIAGE 51720018 * - CONTROL IN ESCAPE SEQUENCE 51780018 LA CBA,TRE(CBA) UPDATE FREE BUFFER AREA ADDRESS 51840018 CLI LWKCNTRL,MC IS CONTROL CHARACTER MACHINE CODE 51900018 BNE DOASA NO, HANDLE ASA CODE 51960018 SPACE 52020018 TM ZERO(RAD),IMMEDOP DO WE HAVE AN IMMEDIATE OPERATION 52080018 BNO CONTCC NO, PLACE DATA IN LINE BUFFER 52140018 SPACE 52200018 B SKIPDATA FORGET DATA BUT EXECUTE CONTROL FUNC 52260018 SPACE 52320018 DOASA DS 0H **** DEFINE TAG 52380018 MVI ZERO(CBA),US SET END OF RECORD IN LINE BUFFER 52440018 TM TDIRSWC,TDIR2770 IS THIS A 2770 000D 52480019 BZ NOT2770A NO FORGET IRS 000D 52520019 MVI ZERO(CBA),IRS USE IRS INSTEAD OF US 000D 52560019 NOT2770A DS 0H 000D 52600019 LA CNT,ONE(CNT) UPDATE BUFFER RECORD COUNT 52640019 LA LNK,DEFAULT GET RETURN FOR BUFFER CHECKING ROUT. 52680019 EJECT 52720019 SPACE 2 52760019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 52800019 * * 52840019 * H A N D L E 2780/2770 B U F F E R M A N A G E M E N T * 52880019 * * 52920019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 52960019 SPACE 2 53000019 CHKBUF DS 0H **** DEFINE TAG 53040019 LA GO,SEV ASSUME 2780 WITH MULTIPLE RECORD 53080019 * - TRANSMISSION FEATURE 53120019 TM TDIRRB,TDIRMRTN DOES 2780 HAVE FEATURE 53160019 BO HASIT YES, USE SEVEN RECORD MAX FOR BUFFER 53200019 * - RECORD CONTROL 53240019 TM TDIRSWC,TDIR2770 IS THIS A 2770 000D 53280019 BO HASIT THATS NICE USE SEVEN RECORDS MAX000D 53320019 SPACE 53360019 LA GO,TWO NO, USE TWO RECORD MAX FOR BUFFER 53400019 * - RECORD CONTROL 53440019 SPACE 53480019 HASIT DS 0H **** DEFINE TAG 53520019 CR GO,CNT BUFFER RECORD COUNT MET 53560019 BNH OUTWCNT YES, EMPTY BUFFER BEFORE CONTINUING 53600019 SPACE 53640019 L ZIP,LWKBFEND GET BUFFER END ADDRESS 53680019 SR ZIP,CBA GET REMAINING FREE SPACE IN BUFFER 53720019 CR ZIP,LNG CAN LINE BUFFER HOLD THIS RECORD 53760019 BL OUTWCNT NO, SEND WHAT WE HAVE IN LINE BUFFER 53800019 SPACE 53840019 BR LNK PLACE RECORD IN LINE BUFFER 53880019 EJECT 53920019 SPACE 2 53960019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 54000019 * * 54040019 * D E T E R M I N E M A X I M U M R E C O R D L E N G T H * 54080019 * * 54120019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 54160019 SPACE 2 54200019 CHKRECSZ DS 0H **** DEFINE TAG 54240019 LA MRL,PUNLNG GET MAXIMUM PUNCH RECORD LENGTH 54280019 CLI LWKID,PUNO IS THIS PUNCH OUTPUT 54320019 BE CKTERM YES, CHECK FOR CONTROL CHARACTER 54360019 SPACE 54400019 SR MRL,MRL CLEAR REGISTER 54440019 IC MRL,TDIRPRNT GET MAXIMUM PRINT DATA RECORD LENGTH 54480019 LA MRL,ONE(MRL) ALLOW FOR CARRIAGE CONTROL CHARACTER 54520019 CKTERM DS 0H **** DEFINE TAG 54560019 SPACE 54600019 CLI LWKCNTRL,NCC IS CONTROL CHARACTER PART OF RECORD 54640019 BNE ALLOWCC YES, ALLOW RECORD LENGTH PLUS ONE 54680019 SPACE 54720019 BCTR MRL,ZIP DISCARD POSSIBILITY OF CONTROL CHAR 54760019 SPACE 54800019 ALLOWCC DS 0H **** DEFINE TAG 54840019 SR GO,GO CLEAR REGISTER 54880019 C GO,LWKRECSZ IS RECORD LENGTH ZERO 54920019 BCR EQ,LNK YES, USE DEVICE SIZE FOR BLOCKING 54960019 SPACE 55000019 CR MRL,LNG IS RECORD LENGTH TO BIG FOR DEVICE 55040019 BCR LO,LNK YES, USE DEVICE SIZE FOR BLOCKING 55080019 SPACE 55120019 LR MRL,LNG USED FIXED RECORD LENGTH FOR BLOCK 55160019 BR LNK RETURN TO MAINLINE 55200019 SPACE 2 55240019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 55280019 * * 55320019 * C O N V E R T C A R R I A G E C O N T R O L TO THE * 55360019 * 2 7 8 0 E Q U I V A L E N T * 55400019 * 2780/2770 E Q U I V A L E N T * 55440019 * * 55480019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 55520019 SPACE 2 55560019 DOCNVRT DS 0H **** DEFINE TAG 55600019 SR GO,GO SET DEFAULT 2780 CARRIAGE CONTROL 55640019 * - SUFFICIENT 55680019 CLI LWKCNTRL,ASA NEED TO CONVERT ASA CONTROL CHAR 55720019 BE HAVEASA YES, CONVERT ASA TO 2780 EQUIVALENT 55760019 EJECT 55800019 SPACE 2 55840019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 55880019 * * 55920019 * C O N V E R T M A C H I N E C O D E T O 2 7 8 0 / 2 7 7 0 * 55960019 * * 56000019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 56040019 SPACE 2 56080019 TM ZERO(RAD),SKIPOPR IS THIS A SKIP OPERATION 56120019 BO SKIPTO8 CONVERT SHIP OPERATION TO 2780 EQUI. 56160019 SPACE 56200019 LA GO,MCCSPOP GET ADDRESS OF 2780 EQUIVALENT SPACE 56240019 * - OPERATIONS 56280019 TM ZERO(RAD),WRTSP3 CHECK FOR WRITE AND TRIPLE SPACE 56320019 BCR ON,LNK IT IS, SELECT 2780 TS EQUIVALENT 56360019 SPACE 56400019 BCTR GO,ZIP SELECT WRITE AND DOUBLE SPACE 56440019 TM ZERO(RAD),WRTSP2 CHECK FOR WRITE AND DOUBLE SPACE 56480019 BCR ON,LNK IT IS, SELECT 2780 DS EQUIVALENT 56520019 SPACE 56560019 BCTR GO,ZIP DEFAULT TO WRITE AND SINGLE SPACE 56600019 BR LNK RETURN 56640019 SPACE 56680019 SKIPTO8 DS 0H **** DEFINE TAG 56720019 LR BAC,GO AND ANOTHER 56760019 IC GO,ZERO(RAD) GET CARRIAGE CONTROL CHARACTER 56800019 SLL GO,SHIF25 GET RID OF SKIP INDICATOR 56840019 SLDL BAC,FOR SEPARATE INCREMENT FROM CONTROL CHAR 56880019 LA GO,MCCSPOP GET 2780 DEFAULT 000D 56920019 TM TDIRSWC,TDIR2770 IS THIS A 2770 000D 56960019 BO OVER YES DONT USE DEFAULT 000D 57000019 SR GO,GO SUB REG 000D 57040019 CH BAC,HALF08 IS CHANNEL SKIP MORE THAN EIGHT 000D 57080019 BCR HI,LNK YES USE DEFAULT 000D 57120019 OVER DS 0H 000D 57160019 LA GO,SKIPCNVT(BAC) GET ADDRESS OF EQUIVALENT 2780 CNTRL 57200019 BR LNK RETURN WITH INFO 57240019 SPACE 2 57280019 EJECT 57320019 SPACE 2 57360019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 57400019 * * 57440019 * C O N V E R T A S A C O D E T O 2 7 8 0 / 2 7 7 0 * 57480019 * * 57520019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 57560019 SPACE 2 57600019 HAVEASA DS 0H **** DEFINE TAG 57640019 SPACE 57680019 CLI ZERO(RAD),F0 CHECK ASA CONTROL CHARACTER TYPE 57720019 BL SPACEOP HANDLE SPACE OPERATION 57760019 SPACE 57800019 BH SKIPOP HANDLE SKIP OPERATION 57840019 SPACE 57880019 LA GO,ASADS HAVE AN ASA DOUBLE SPACE OPERATION 57920019 * - SINGLE SPACE PRINTER BEFORE 57960019 * - SENDING OUTPUT TO 2780 58000019 BR LNK 58040019 SPACE 58080019 SPACEOP DS 0H **** DEFINE TAG 58120019 TM TDIRSWC,TDIR2770 IS THIS A 2770 000D 58160019 BZ OVERX NO CONTINUE AS IF ITS A 2780 000D 58200019 CLI ZERO(RAD),ABLE HAVE CHANNEL SKIP 000D 58240019 BNL SKIPOP YES SKIP 10,11 OR 12 000D 58280019 OVERX DS 0H 000D 58320019 CLI ZERO(RAD),ASTIS IS SPACE OPERATION ASA TRIPLE SPACE 58360019 BCR NE,LNK NO, DEFAULT TO SINGLE SPACE 58400019 SPACE 58440019 LA GO,ASATS DOUBLE SPACE PRINTER BEFORE SENDING 58480019 BR LNK - OUTPUT TO 2780 58520019 SPACE 58560019 SKIPOP DS 0H **** DEFINE TAG 58600019 CLI ZERO(RAD),F8 NEED TO SKIP PAST 8 000D 58640019 BNH DOALL NO SKIP 2770 OR 2780 000D 58680019 TM TDIRSWC,TDIR2770 IS THIS A 2770 000D 58720019 BCR EQ,LNK NO DONT SKIP 2780 000D 58760019 DOALL DS 0H 000D 58800019 CLI ZERO(RAD),CONE SKIP CHANNEL 1 THRU 9 000D 58840019 BNL FRIGIT YES SKIP THEM 000D 58880019 LA GO,ABC+2 ASSUME CHANNEL 12 000D 58920019 CLI ZERO(RAD),CHARC IS IT CHANNEL 12 000D 58960019 BCR EQ,LNK VERY GOOD SKIP IT 000D 59000019 BCTR GO,ZIP ASSUME CHANNEL 11 000D 59040019 CLI ZERO(RAD),CHARB IS IT ELEVEN 000D 59080019 BCR EQ,LNK VERY GOOD SKIP IT 000D 59120019 BCTR GO,ZIP ASSUME CHANNEL 10 000D 59160019 CLI ZERO(RAD),ABLE IS IT TEN 000D 59200019 BCR EQ,LNK SKIP TO TEN 000D 59240019 SR GO,GO FORGET SUPPRESS SPACE 000D 59280019 BR LNK DONE IT HERE DOIT TOIT THERE 000D 59320019 FRIGIT DS 0H 000D 59360019 SPACE 59400019 IC GO,ZERO(RAD) GET CONTROL CHARACTER 59440019 LA GO,ASACNVT(GO) GET POSITION OF EQUIVALEN 2780 59480019 BR LNK - CARRIAGE CONTROL AND RETURN 59520019 EJECT 59560019 SPACE 2 59600019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 59640019 * * 59680019 * 2780/2770 M U L T I P O I N T C O N S I D E R A T I O N S * 59720019 * * 59760019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 59800019 SPACE 2 59840019 MULTHEAD DS 0H **** DEFINE TAG 59880019 NI TDIRSWCH+1,TDIRWRTF SET WRITE INITIAL TO FORCE COMPONENT 59920019 * - SELECTION 59960019 TM TDIRSWC,TDIR2770 IS IT A 2770 000D 60000019 BO DONTF3IT YES DONT PUT IN F3 CHAR 000D 60040019 MVI TDIRDFTM+1,PRTID SELECT PRINTER WHILE SELECTING 60080019 B SKIPPUN CONTINUE HEADER PROCESSING 60120019 DONTF3IT DS 0H 000D 60160019 MVI TDIRDFTM+2,DC1 SELECT 2770 PRINTER 000D 60200019 CLI LWKID,PUNO CHECK IF IT REALLY WANTS PUNCH 000D 60240019 BNE PUNITNOT NO LEAVE IT A PRINTER 000D 60280019 MVI TDIRDFTM+2,DC2 NO SELECT A PUNCH 000D 60320019 PUNITNOT EQU * 000D 60360019 B SKIPPUN 000D 60400019 SPACE 2 60440019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 60480019 * * 60520019 * 2 7 8 0 P U N C H O U T P U T P R O C E S S O R * 60560019 * * 60600019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 60640019 SPACE 2 60680019 PUNCH80 DS 0H **** DEFINE TAG 60720019 MVC ZERO(TRE,BSA),DLESTX MOVE IN DLE STX DATA LINK CONTROL 60760019 MVC TRE(L80,BSA),TWO(BSA) BLANK REMAINING BUFFER AREA 60800019 SPACE 60840019 CLI LWKCNTRL,NCC CARRIAGE CONTROL ABSENT FROM DATA 60880019 BE NOCC YES, FORGET CARRIAGE CONTROL PROCESS 60920019 SPACE 60960019 LA RAD,ONE(RAD) SKIP OVER CARRIAGE CONTROL IN DATA 61000019 BCTR LNG,ZIP FORGET CONTROL CHARACTER LENGTH 61040019 SPACE 61080019 NOCC DS 0H **** DEFINE TAG 61120019 LA CBA,TWO(BSA) UPDATE FREE BUFFER AREA ADDRESS 61160019 BCTR LNG,ZIP DECREMENT LENGTH ONE FOR MOVE 61200019 EX LNG,MOVREC MOVE PUNCH OUTPUT TO LINE BUFFER 61240019 SPACE 61280019 LA CBA,ATY(CBA) UPDATE FREE BUFFER ADDRESS 61320019 B OUTWCTE TRANSMIT DATA AND RETURN 61360019 SPACE 2 61400019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 61440019 * * 61480019 * 2780 AND 2770 S E L E C T I O N P R O C E S S O R * 61520019 * * 61560019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 61600019 SPACE 2 61640019 SELPUN DS 0H **** DEFINE TAG 61680019 LA CBA,TRE(BSA) UPDATE FREE BUFFER AREA ADDRESS 61720019 MVC ZERO(TRE,BSA),SEQ4 PLACE ESCAPE SEQUENCE TO SELECT 2780 61760019 TM TDIRSWC,TDIR2770 IS THIS A 2770 000D 61800019 BZ OVARY NO FORGET IT 000D 61840019 MVI TWO(BSA),BLANK STAMP OUT 2780 COMPONENT SELECT 000D 61880019 CLI LCBTYPLN,LCBMULPT CHECK FOR MULTI DROP LINE 000D 61920019 BE OVARY YES SKIP DEVICE SELECT CHAR 000D 61960019 MVI ONE(BSA),DC1 SELECT 2770 PRINTER 000D 62000019 CLI LWKID,PUNO A PUNCH NEEDED 000D 62040019 BNE OVARY NO DONE SELECTING 000D 62080019 MVI ONE(BSA),DC2 SELECT A PUNCH 000D 62120019 OVARY DS 0H 000D 62160019 * - PUNCH IN LINE BUFFER 62200019 LA LNK,SKIPPUN GET RETURN AFT SELCTING DVICE A35908 62240020 B OUTWCNT SELECT PUNCH 62280019 WEOT EQU * 000D 62320019 MVI ZERO(BSA),STX MOVEIN STX CHARACTER 000D 62420019 MVI ONE(BSA),ETX MOVEIN ETX CHARACTER 000D 62520019 LA CBA,TWO(BSA) SET BUFFER POINTER 000D 62620019 LA LNK,RETWEOT SET RETURN ADDRESS 000D 62720019 LA LK2,OUTWANT SET RETURN ADDRESS 000D 62820019 B SETUPT GO SETUP FOR LINE I/O 000D 62920019 WEOD EQU * 63020019 TM TDIRSWC,TDIRETXO SHOULD STX ETX BE SENT 000D 63120019 BZ EXITA NO RETURN NORMAL 000D 63220019 MVI ZERO(BSA),STX MOVE IN STX CHARACTER 000D 63320019 MVI ONE(BSA),ETX MOVE IN ETX CHARACTER 000D 63420019 LA CBA,TWO(BSA) SET LENGTH PARAMETER 000D 63520019 LA LK2,OUTWANT SET RETURN REG 000D 63620019 LA LNK,EXITA SET RETURN REG 000D 63720019 B SETUPT GO SET UP BUFFER AND DO WRITE 000D 63820019 EJECT 63960018 SPACE 2 64020018 *********************************************************************** 64080018 *---------------------------------------------------------------------* 64140018 *-*******************************************************************-* 64200018 *-* *-* 64260018 *-* C E N T R A L C L O S E D O W N H E A D E R *-* 64320018 *-* P R O C E S S O R FOR C P U *-* 64380018 *-* *-* 64440018 *-*******************************************************************-* 64500018 *---------------------------------------------------------------------* 64560018 *********************************************************************** 64620018 SPACE 2 64680018 HANGITUP DS 0H **** DEFINE TAG FOR BRANCHING 64740018 LA CBA,CHDR(BSA) GET LENGTH OF CLOSEDOWN HEADER 64800018 NI LCBNSWFL,LCBSWOFF TURN OFF LCB SWITCHES 64860018 MVC ZERO(CHDR,BSA),CLOS MOVE HEADER INTO LINE BUFFER 64920018 SPACE 2 64980018 *********************************************************************** 65040018 *---------------------------------------------------------------------* 65100018 *-*******************************************************************-* 65160018 *-* *-* 65220018 *-* N O N - T R A N S P A R E N T W R I T E P R O C E S S O R *-* 65280018 *-* *-* 65340018 *-*******************************************************************-* 65400018 *---------------------------------------------------------------------* 65460018 *********************************************************************** 65520018 SPACE 2 65580018 OUTWCNTE DS 0H **** DEFINE TAG 65640018 LA LNK,EXIT SET RETURN AS EXIT 65700018 OUTWCNT DS 0H **** DEFINE TAG 65760018 BAL LK2,SETUPNT SET UP PARAMETERS FOR BTAM WRITE 65820018 OUTWANT EQU * 65850019 SPACE 65880018 TM TDIRSWCH+1,TDIRWRTN IS INITIAL OPERATION REQUIRED 65940018 BO WRTTT NO, DO WRITE CONTINUE 66000018 SPACE 66060018 CLI LCBTYPLN,LCBSWTCH IS THIS A SWITCHED LINE 66120018 BNE WRTTI NO, DO A WRITE INITIAL OPERATION 66180018 EJECT 66240018 SPACE 2 66300018 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 66360018 * * 66420018 * W R I T E E N Q U I R Y O P E R A T I O N * 66480018 * * 66540018 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 66600018 WRTENQ DS 0H 000D 66650019 SPACE 66700019 WRITE (1),TQ,MF=E WRITE ENQ TO BID FOR THE LINE 66750019 SPACE 66800019 BAL LK2,CHKOUT CHECK OUT WRITE FOR ERROR 66850019 TM TDIRSWC,TDIRWCOF WAS WACK RECEIVED BEFORE 000D 66900019 BO WRTDUN1 YES PROCESS NEXT RECORD 000D 66950019 SPACE 2 67000019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 67050019 * * 67100019 * W R I T E C O N T I N U E O P E R A T I O N * 67150019 * * 67200019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 67250019 SPACE 67300019 WRTTT DS 0H **** DEFINE TAG 67350019 SPACE 67400019 WRITE (1),TT,,(BSA),(CBA),MF=E WRITE CONTINUE *67450019 - NONTRANSPARENT 67500019 EJECT 67520021 SPACE 2 67550019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 67600019 * * 67650019 * P O S T B T A M W R I T E P R O C E S S I N G * 67700019 * * 67750019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 67800019 SPACE 2 67850019 WRTDUN DS 0H **** DEFINE TAG 67900019 BAL LK2,CHKOUT CHECK OUT WRITE FOR ERRORS 67950019 WRTDUN1 DS 0H 000D 68000019 SPACE 68050019 OI TDIRSWCH+1,TDIRWRTN SET WRITE CONTINUE REQUIRED 68100019 SPACE 68150019 TM TDIRSWCH+2,TDIRMCHN IS THIS A 2780 WORK STATION 68200019 BZ BUF80 YES, PROCESS 2780 BUFFER REQ'MENTS 68250019 SPACE 2 68350019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 68400019 * * 68450019 * H A N D L E C P U B U F F E R R E Q U I R E M E N T S * 68500019 * * 68550019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 68600019 SPACE 68650019 MVC ZERO(TRE,BSA),DLESTX MOVE IN DLE STX DATA LINK CONTROL 68700019 MVC TRE(L200,BSA),TWO(BSA) BLANK SOME OF LINE BUFFER 68750019 MVC D203(L199,BSA),D202(BSA) BLANK REMAINING LINE BUFFER 68800019 SPACE 68850019 LA CBA,TWO(BSA) UPDATE FREE BUFFER AREA ADDRESS 68900019 BR LNK RETURN TO OUTPUT PROCESSING 68950019 SPACE 2 69000019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 69050019 * * 69100019 * H A N D L E 2 7 8 0 B U F F E R R E Q U I R E M E N T S * 69150019 * * 69200019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 69250019 SPACE 69300019 BUF80 DS 0H **** DEFINE TAG 69350019 LR CBA,BSA INITIALIZE FREE BUFFER AREA ADDRESS 69400019 SR CNT,CNT INITIALIZE BUFFER RECORD COUNT 69450019 MVC TDIRDTTR(FOR),LWKTTR SAVE CURRENT TTR FOR POSSIBLE DSCNT 69500019 MVI ZERO(BSA),STX PLACE DATA LINK CONTROL IN BUFFER 69550019 BR LNK RETURN TO OUTPUT PROCESSING 69600019 EJECT 69620021 SPACE 2 69650019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 69700019 * * 69750019 * W R I T E I N I T I A L O P E R A T I O N * 69800019 * * 69850019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 69900019 SPACE 69950019 WRTTI DS 0H **** DEFINE TAG 70000019 SPACE 70050019 WRITE (1),TI,,(BSA),(CBA),(BAC),,MF=E WRITE INITIAL *70100019 - NONTRANSPARENT 70150019 SPACE 70200019 B WRTDUN CHECK OUT WRITE 70250019 SPACE 2 70300021 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 70350019 * * 70400019 * C P U M E S S A G E O U T P U T P R O C E S S O R * 70450019 * * 70500019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 70550019 SPACE 70600019 SNDMSG DS 0H **** DEFINE TAG 70650019 EX LNG,MOVREC MOVE MESSAGE INTO LINE BUFFER 70700019 LA CBA,STY(CBA) UPDATE BUFFER ADDRESS 70750019 EJECT 70770021 SPACE 2 70800019 *********************************************************************** 70850019 *---------------------------------------------------------------------* 70900019 *-*******************************************************************-* 70950019 *-* *-* 71000019 *-* T R A N S P A R E N T W R I T E P R O C E S S O R *-* 71050019 *-* *-* 71100019 *-*******************************************************************-* 71150019 *---------------------------------------------------------------------* 71200019 *********************************************************************** 71250019 SPACE 2 71300019 OUTWCTE DS 0H **** DEFINE TAG 71350019 LA LNK,EXIT SET EXIT AS RETURN 71400019 SPACE 71450019 OUTWCT DS 0H **** DEFINE TAG 71500019 BAL LK2,SETUPT SET UP PARMS FOR BTAM WRITE 71550019 SPACE 71600019 TM TDIRSWCH+1,TDIRWRTN IS INITIAL OPERATION REQUIRED 71650019 BO WRTTTX NO, DO A WRITE CONTINUE 71700019 TM TDIRSWC,TDIR2770 IS THIS A 2770 000D 71750019 BZ NOTRUE NO FORGET IT DO 2780 000D 71800019 MVI TDIRDFTM+2,DC2 SELECT A 2770 PUNCH 000D 71850019 B WRTTIX GO TELL 2770 THE GOOD NEWS 000D 71900019 NOTRUE DS 0H 000D 71950019 SPACE 72000019 MVI TDIRDFTM+1,PUNID PLACE PUNCH SELECTION IN DEFINE 72050019 * - TERMINAL LIST 72100019 SPACE 2 72150019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 72200019 * * 72250019 * W R I T E I N I T I A L O P E R A T I O N * 72300019 * * 72350019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 72400019 WRTTIX DS 0H 000D 72450019 SPACE 73080018 WRITE (1),TIE,,(BSA),(CBA),(BAC),,MF=E WRITE INITIAL 000D*73140019 - TRANSPARENT 73200018 SPACE 73260018 B WRTDUN CHECK OUT WRITE OPERATION 73320018 EJECT 73380018 SPACE 2 73440018 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 73500018 * * 73560018 * W R I T E C O N T I N U E O P E R A T I O N * 73620018 * * 73680018 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 73740018 SPACE 2 73800018 WRTTTX DS 0H **** DEFINE TAG 73860018 SPACE 73920018 WRITE (1),TTE,,(BSA),(CBA),MF=E WRITE CONTINUE 000D*73980019 - TRANSPARENT 74040018 SPACE 74100018 B WRTDUN CHECK OUT WRITE OPERATION 74160018 SPACE 2 74220018 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 74280018 * * 74340018 * S E T U P B T A M W R I T E P A R A M E T E R S * 74400018 * * 74460018 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 74520018 SPACE 2 74580018 SETUPNT DS 0H **** DEFINE TAG 74640018 TM TDIRSWC,TDIR2770 TEST FOR 2770 000D 74650019 BZ NOITSNOT NO SKIP MOVING IRS CHARACTER 000D 74660019 MVI ZERO(CBA),IRS YES MOVE IN IRS CHAR FOR CARR 000D 74670019 LA CBA,ONE(CBA) STEP BUFFER POINTER BY ONE 000E 74680018 MVI ZERO(CBA),ETB MOVE IN END OF TEXT CHARACTER 000D 74682019 TM TDIRSWC,TDIRETXO TEST IF END OF TEXT IS ON 000D 74684019 BZ OVERETX NO DONT MOVE IN END OF TEXT CHAR 000D 74686019 NOITSNOT DS 0H ****DEFINE TAG 000D 74706019 MVI ZERO(CBA),ETX PLACE ENDING DATA LINK CONTROL AFTER 74726019 * - DATA TO BE TRANSMITTED 74760018 OVERETX EQU * 74790019 LA CBA,ONE(CBA) UPDATE FREE BUFFER AREA ADDRESS 74820018 SPACE 74880018 SETUPT DS 0H **** DEFINE TAG 74940018 SR CBA,BSA COMPUTE DATA LENGTH 75000018 L PAR,LCBLDECB GET LINE DECB ADDRESS FROM LCB 75060018 LA BAC,TDIRDFTM GET DEFINE TERMINAL LIST ADDRESS 75120018 BR LK2 RETURN AND SEND DATA 75180018 EJECT 75240018 SPACE 2 75300018 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 75360018 * * 75420018 * D E T E R M I N E S U C C E S S OR F A I L U R E OF * 75480018 * W R I T E O P E R A T I O N E X E C U T E D * 75540018 * * 75600018 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 75660018 SPACE 75720018 CHKOUT DS 0H **** DEFINE TAG 75780018 NI TDIRSWCH+2,TDIRBUFF SET LINE BUFFER EMPTY 75840018 LTR GO,GO WAS IT A GOOD START I/O 75900018 BNZ OUTERR NO, CHECK OUT ERROR 75960018 SPACE 76020018 L GO,LWKADISP GET RJE DISPATCHER ENTRY POINT 76080018 BALR BAC,GO WAIT FOR I/O COMPLETION IN DISP 76140018 SPACE 76200018 CLI DECSDECB,NORMAL NORMAL COMPLETION 76260018 BNE HADERR NO, CHECK OUT ERROR 76320018 SPACE 76380018 SR ZIP,ZIP SET DISCONTINUE INDICATION 76440018 CLI DECRESPN,EOT WHAT CAUSED NORMAL COMPLETION, EOT 76500018 * - NAK, ACK0-1,OR WACK 000D 76540019 LA GO,FIFTEEN SET COUNT FOR NUMBER OF RETRYS 000D 76580019 BL TSTMOR HAD POSITIVE ACKNOWLEDGEMENT 000D 76620019 SPACE 76660019 BE DISCONT HAD EOT RESPONSE, DISCONTINUE OUTPUT 76700019 SPACE 2 76740019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 76780019 * * 76820019 * I N T E R N A L D I S C O N T I N U E P R O C E S S O R * 76860019 * * 76900019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 76940019 SPACE 76980019 INTLDIS DS 0H **** DEFINE TAG 77020019 LNR ZIP,BAS HAD NEGATIVE ACKNOWLEDGEMENT OR 77060019 * - CONTENTION, SET INTERNAL DISCONT. 77100019 EJECT 77120021 SPACE 2 77140019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 77180019 * * 77220019 * D I S C O N T I N U E O U T P U T * 77260019 * * 77300019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 77340019 SPACE 77380019 SPACE 77420019 DISCONT DS 0H **** DEFINE TAG 77460019 LTR LNG,LNG CLOSEDOWN PROCESSING 77500019 BM EXIT YES, IGNORE ERROR AND DO GOOD RETURN 77540019 SPACE 77580019 ST ZIP,LCBPARM1 PASS RETURN INFO ON BAD RETURN 77620019 NI TDIRSWCH+2,TDIRHDRF SET HEADER REQUIRED INDICATOR 77660019 LA GO,FOR SET ERROR INDICATOR 77700019 B EXITERR RETURN WITH ERROR 77740019 SPACE 2 77820019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 77860019 * * 77900019 * C H E C K O U T E R R O R R E C O V E R Y * 77940019 * * 77980019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 78020019 SPACE 2 78060019 HADERR DS 0H **** DEFINE TAG 78100019 CLI DECSDECB,IOERR IS I/O ERROR INDICATED 78140019 BNE OUTERR NO, GO DO AN LINE ERROR RJEND 78180019 SPACE 78220019 TM DECFLAGS,CONTENT IS THIS CONTENTION 78260019 BO INTLDIS YES, SET INTERNAL DISCONTINUE IND. 78300019 CLI DECRESPN,NAK CHECK FOR NAK RESPONSE TO 000D 78340019 * SELECTION 000D 78380019 BNE OUTERR NO NAK DO RJENDF 000D 78420019 CLI DECTYPE,WTI YES CHECK IF WRITE IS NON-TRANS 000D 78460019 BE WRTTI PARENT YES DO WRITE TI 000D 78500019 CLI DECTYPE,WTIX IS IT A TRANSPARENT WRITE 000D 78540019 BE WRTTIX YES DO A WRITE TTIX 000D 78580019 * NO DO RJENDF 000D 78620019 EJECT 78640021 SPACE 2 78660019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 78700019 * * 78740019 * L I N E E R R O R P R O C E S S O R * 78780019 * * 78820019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 78860019 SPACE 78900019 OUTERR DS 0H **** DEFINE TAG 78940019 LA ZIP,RJENDF SET LINE ERROR INDICATOR 78980019 B DISCONT RETURN WITH ERROR 79020019 BUF2770 LA ZIP,TOT124(BSA) GUESS IT IS A LITTLE BUFFER A37778 79060020 TM TDIRSWC,TDIREB27 IS IT A BIGGY 000D 79100019 BZ RESUME NO GOOD GUESS 000D 79140019 LA ZIP,TOT252(BSA) BAD ITS A BIGGY A37778 79180020 B RESUME BACK TO MAINLINR 000D 79220019 SPACE 79228021 BUF2780 LA ZIP,390(BSA) SET 2780 BFR SIZE TO 390+CTLCHRS A53110 79236021 B RESUME A53110 79244021 SPACE 79252021 TSTMOR DS 0H 000D 79260019 CLI DECRESPN+1,WACK WAS THE RESPONSE A WACK 000D 79300019 BCR NE,LK2 NO THANKS BE \3 ALI 000D 79340019 CLI DECTYPE,X'02' CHECK FOR WRITE ININTIAL 000D 79380019 BE WRTTI SELECTION IF SO RETRANSMIT 000D 79420019 CLI DECTYPE,X'12' INITIAL SELECTION 000D 79460019 BE WRTTIX NO TREAT AS NORMAL WACK 000D 79500019 TM TDIRSWC,TDIRWCOF YES WAS IT RECEIVED BEFORE 000D 79540019 BO WACKIT YES GO WRITE ENQ 000D 79580019 LA GO,FIFTEEN SET COUNT FOR NUMBER OF RETRYS 000D 79620019 ST GO,LCBPARM3 SAVE THE BEAUTY FOR FUTHER REF 000D 79660019 OI TDIRSWC,TDIRWCON SET SWITCH THAT WACK RECEIVED 000D 79700019 WACKIT DS 0H 000D 79740019 L GO,LCBPARM3 RELOAD NUMBER OF RETRYS LEFT 000D 79780019 BCT GO,TGIT IF COUNT NOT ZERO GO DO WRT ENQ 000D 79820019 B OUTERR COUNT ZERO ITS AN ERROR GIVE UP 000D 79860019 TGIT DS 0H 000D 79900019 ST GO,LCBPARM3 STORE COUNT FOR LATER REF 000D 79940019 B WRTENQ GO DO WRITE ENQ 000D 79980019 EJECT 80000021 SPACE 2 80020019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 80060019 * * 80100019 * E X E C U T E D I N S T R U C T I O N S * 80140019 * * 80180019 *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* *-* 80220019 SPACE 2 80260019 MOVREC MVC ZERO(ZERO,CBA),ZERO(RAD) MOVE DATA TO LINE BUFFER 80300019 SPACE 80340019 TRINST TR ZERO(ZERO,RAD),ZERO(BAC) REPLACE DATA LINK CONTROL 80380019 * - CHARACTERS IN 2780 PRINTER 80420019 * - OUTPUT WITH BLANKS 80460019 SPACE 80540019 *********************************************************************** 80580019 *---------------------------------------------------------------------* 80620019 *-*******************************************************************-* 80660019 *-* *-* 80700019 *-* C O N S T A N T S U S E D BY THIS R O U T I N E *-* 80740019 *-* *-* 80780019 *-*******************************************************************-* 80820019 *---------------------------------------------------------------------* 80860019 *********************************************************************** 80900019 SPACE 2 80940019 TRTABAD DC A(IHKTRTAB) 80980019 PACKENTY DC A(IHKADPCK) IHKCHPCK ENTRY POINT ADDRESS 81020019 HALF08 DC H'08' 000D 81060019 SKIPIT DC X'27C11F' 2780 SKIP TO CHANNEL ONE ESCAPE SEQUENCE 81100019 DLESTX DC X'100240' DLE STX DATA LINK CONTROL PLUS A BLANK 81140019 CLOS DC X'01F502' CPU CENTRAL CLOSEDOWN HEADER 81180019 SEQ4 DC X'0227F4' STX PLUS 2780 ESCAPE SEQUENCE TO SELECT 81220019 * - THE PUNCH TO RECEIVE OUTPUT 81260019 ESCS DC X'27' 2780 WRITE AND SPACE ONE ESCAPE SEQUENCE 81300019 ASADS DC C'/' 000D 81340019 ASATS DS 0C 2780 TRIPLE SPACE AND WRITE ASA CODE 81380019 * - EQUIVALENT 81420019 DC C'S' 2780 WRITE AND SPACE TWO MACHINE CODE 81460019 * - EQUIVALENT 81500019 MCCSPOP DC C'T' 2780 WRITE AND SPACE THREE MACHINE CODE 81540019 * - EQUIVALENT 81580019 ORG *-D241 81620019 ASACNVT DS 0C BASE TO INDEX 2780 ASA CODE SKIP EQUIV. 81660019 DS 240C FILLER 81700019 SKIPCNVT DS CL1 BASE TO INDEX 2780/2770 MACHINE 000D 81740019 * CODE CHANNEL 81780019 DC C'ABCDEFGHI' SKIP EQUIVALENTS 000D 81820019 ABC DC C'JKL' 000D 81860019 LIST DC 2F'00' 82430018 OPEN DC X'00' 82450018 EJECT 82560018 *********************************************************************** 82620018 *---------------------------------------------------------------------* 82680018 *-*******************************************************************-* 82740018 *-* *-* 82800018 *-* E M I T T O R W O R K A R E A D S E C T *-* 82860018 *-* *-* 82920018 *-* THIS WORKAREA DSECT IS USED BOTH BY IHKABLWR, IHKCHLWR, *-* 82980018 *-* AND IHKABORT. IF THE WORKAREA IS CHANGED, THE CORRESPOND- *-* 83040018 *-* ING DSECT CHANGES MUST BE MADE TO ALL OF THESE MODULES. *-* 83100018 *-* *-* 83160018 *-* THE WORKAREA IS GETMAINED BY IHKABLWR(MVT) OR IHKCHLWR(MFT)*-* 83220018 *-* WHEN IHKABLST CALLS ON THIS ROUTINES TO PROCESS OUTPUT FOR *-* 83280018 *-* A PARTICULAR WORK STATION. THIS AREA IS FREEMAINED WHEN *-* 83340018 *-* THERE IS NO MORE OUTPUT ON THE QUEUE TO BE PROCESSED AND *-* 83400018 *-* CONTROL IS RETURNED TO IHKABLST. *-* 83460018 *-* *-* 83520018 *-* THE SIZE OF THE AREA OBTAINED IS SPECIFIED WITH THE *-* 83580018 *-* EQUATED TAG, LWRSIZE, IN THE LWR MODULE. AN INCREASE OR *-* 83640018 *-* DECREASE IN THE WORKAREA SIZE IS SPECIFIED BY REDEFINING *-* 83700018 *-* THIS SYMBOLIC TAG. *-* 83760018 *-* *-* 83820018 *-*******************************************************************-* 83880018 *---------------------------------------------------------------------* 83940018 *********************************************************************** 84000018 SPACE 84060018 SPACE 84120018 LWKWORK DSECT 84180018 LWKADFST DS CL4 ADDR OF FASTABLE ENTRY 84240018 LWKADJED DS CL4 ADDR OF CORE JED ENTRY 84300018 LWKADDSB DS CL4 ADDR OF DSB POINTING TO DATA 84360018 * SET TO BE SCRATCHED 84420018 LWKDOUBL EQU LWKADDSB DOUBLE WORD FOR DECIMAL CONVERT 84480018 LWKADQMP DS CL4 ADDR OF QUEUE MANAGER PARAMETER 84540018 * AREA 84600018 LWKADCBS DS CL4 A(IHKCDCBS) 84660018 LWKADISP DS CL4 V(IHKAADSP) 84720018 * FIRST BIT- 84780018 * '1'-MSG 84840018 * '0'-BRDCST 84900018 LWKMDQK DS CL4 CONTROL VALUE 84960018 LWKMDQIO DS CL4 ADDR OF 60 BYTE I/O AREA 85020018 LWKMDQTD DS CL4 ADDR OF TERMINAL DIRECTORY 85080018 * ENTRY 85140018 * FIRST BIT- 85200018 * '1'-DO NOT DELETE TEXT 85260018 * '0'-DELETE TEXT 85320018 LWKTIOTO DS CL4 ADDR OF OLD TIOT 85380018 LWKTIOTN DS CL4 ADDR OF NEW TIOT IN GETMAIN 85440018 LWKTIOTL DS CL4 NO. BYTES IN TIOT GETMAIN AREA 85500018 LWKADTCB DS CL4 ADDRESS OF TCB 85560018 LWKSYSCT DS C COUNTER OF 24 SYSOUT CLASSES 85620018 LWKID DS C IDENTIFIES DESTINATION DEVICE 85680018 LWKPRINH EQU C'1' PRINTER 85740018 LWKPUNCH EQU C'2' PUNCH 85800018 LWKEYBDH EQU C'3' KEYBOARD 85860018 LWKUSEXH EQU C'4' USER EXIT 85920018 LWKCNTRL DS C IDENTIFIES CONTROL CHARACTERS 85980018 LWKMACHH EQU C'1' MACHINE CODE 86040018 LWKASACH EQU C'2' ASA 86100018 LWKNONEH EQU C'3' NONE 86160018 LWKRECFM DS C RECORD FORMAT 86220018 LWKFXUBH EQU C'1' FIXED UNBLOCKED 86280018 LWKFXBLH EQU C'2' FIXED BLOCKED 86340018 LWKVAUBH EQU C'3' VARIABLE UNBLOCKED 86400018 LWKVARBH EQU C'4' VARIABLE BLOCKED 86460018 LWKUNDFH EQU C'5' UNDEFINED 86520018 LWKRECSZ DS CL4 RECORD SIZE(BINARY) 86580018 LWKTIME DS XL8 TIME AND DATE 19018 86588018 LWKCOUNT DS XL4 SYSOUT COUNT 19018 86596018 LWKSTATS DS XL1 ERROR STATUS 19018 86604018 LWKIOERR EQU X'04' ERROR INDICATOR 19018 86612018 LWKDS DS XL1 DATA SET COUNT 19018 86620018 LWKPAD DS XL2 UNUSED, NEEDED TO PAD 19018 86628018 LWKTTR DS CL4 TTR OF LAST BLOCK OF SYSOUT 86640018 * DATA JUST READ 86700018 LWKSAVE DS 11CL4 SAVE AREA FOR REGS 4-14 86760018 LWKSAVE6 DS CL4 HOLDS REG 6 DURING SMB HANDLER 86820018 LWKSTABF DS CL4 ADDR OF INPUT BUFFER 86880018 LWKENDBF DS CL4 ADDR OF 1ST BYTE BEYOND 86940018 LWKDTTR DS CL4 TTR TO START READING 87000018 LWKBFEND DS CL4 ABOUT BUFFER END ADDRESS 87060018 LWKORTSV DS CL12 IHKABOUT BUFFER MANG INFO 87120018 SPACE 87180018 *********************************************************************** 87240018 SPACE 2 87300018 IHKDSECT TDIR,,,,LCB 87360018 EJECT 87420018 IECTDECB 87480018 END 87540018 ./ ADD SSI=01013556,NAME=IHKABRER,SOURCE=0 RER TITLE '''IHKABRER'' - OPEN SYSOUT DATA SET' 00700015 IHKABRER CSECT 01400015 * 679000 A28206 01700019 *168000 A32869 01900020 *C708000-712000 A40162 02000020 *A 101000-113000,764000-766000 A47445 02200021 *D 105000-112000 A47445 02400021 *D070000,497000,702000-704000,770000-777000 A47442 02440021 *A070000-076000,241000,497000-500000,519000,523000,586000- A47442 02480021 *A587000,702000-706720,770000,917300-919400,938500-944500 A47442 02520021 *C182000,476000,707000,805000 A47442 02560021 * * 02600021 *TITLE 'IHKABRER'-SAYS IF SYSOUT DATA SET MAY BE OPENED * 02800015 * * 03500015 * STATUS: CHANGE LEVEL 2, RELEASE 21.7 * 04200021 * * 04900015 *FUNCTION/OPERATION- * 05600015 * * 06300015 * READ JFCB INTO CORE AND CHANGE ITS BUFNO FIELD TO ZERO. ABRERA47442 07000021 * VERIFIES THAT THE SYSOUT VOLUME IS MOUNTED ON UNIT INDICATED A47442 07100021 * IN TIOT. IF NOT, THEN IT SEARCHES THE UCB TABLE TO FIND THE A47442 07200021 * UNIT ON WHICH VOLUME IS MOUNTED. IF VOLUME CANNOT BE FOUND, A47442 07300021 * DATA SET IS NOT OPENED AND ADDRESS OF VOLID IS RETURNED A47442 07400021 * TO ABLWR IN REGISTER 15. IF VOLUME IS FOUND UCB ADDR A47442 07500021 * IS STORED INTO NEW TIOT. USING A47442 07600021 * THE DSNAME OF THE JFCB, TRY TO READ THE CORRESPONDING DSCB FROM * 07700015 * THE VTOC IF POSSIBLE. IF NO DSCB IS AVAILABLE, INDICATE * 08400015 * 'NOT OPENED'. WHEN THE DSCB IS READ, CHECK THE TTR OF THE LAST * 09100015 * BLOCK WRITTEN FOR ZERO. A ZERO MEANS THE DATA SET WAS NOT USED * 09800015 * AND IS EMPTY OR IS A MULTI-VOLUME DATA SET. IF THE TTR IS A47445 10100021 * ZERO, THEN THE JFCBNVOL FIELD IS TESTED FOR >1. IF >1, A47445 10400021 * THEN THE DATA SET IS MULTI-VOLUME. IF NOT >1, THE DATA SET A47445 10700021 * IS EMPTY, SO INDICATE 'NOT OPENED'. IF THE TTR IS NON-ZERO A47445 11000021 * OR JFCBNVOL >1, TRY THE OPENJ AND INDICATE 'TRIED TO OPEN'. A47445 11300021 * * 11900015 *ENTRY POINT - * 12600015 * IHKABRER - CALLED ONLY BY IHKABLWR. CALLING SEQUENCE IS * 13300015 * LA R1,PARLIST * 14000015 * LINK EP=IHKABRER * 14700015 * * 15400015 *INPUT - * 16100015 * THE PARAMETER LIST WHOSE ADR IS PASSED IN REG 1 HAS 3 A32869 16800020 * WORDS - * 17500015 * 1. POINTER TO SYSOUT NEW TIOT A47442 18200021 * 2. POINTER TO SYSOUT DCB. * 18900015 * 3. POINTER TO TDIR 19200020 * * 19600015 *OUTPUT - * 20300015 * * 21000015 * REGISTER 15 CONTAINS A RETURN CODE INDICATING WHETHER OR NOT * 21700015 * TO OPEN. * 22400015 * R15 = 0, TRIED TO OPEN * 23100015 * R15 = NON-0, NOT OPENED * 23800015 * R15 = A(VOLID) IF VOLUME COULD NOT BE FOUND A47442 24100021 * * 24500015 *EXTERNAL ROUTINES - * 25200015 * * 25900015 * 'SVC 64' - RDJFCB MACRO, READS JFCB TO CORE. * 26600015 * 'SVC 27' - OBTAIN MACRO, READS DSCB TO CORE. * 27300015 * 'SVC 22' - OPENJ MACRO, OPENS SYSOUT DATA SET * 28000015 * * 28700015 *EXITS-NORMAL - * 29400015 * * 30100015 * RETURNS TO ADDRESS IN REGISTER 14 WITH RETURN CODE IN REGISTER 15.* 30800015 * * 31500015 *EXITS-ERROR - * 32200015 * * 32900015 * N/A * 33600015 * * 34300015 *TABLES, WORKAREAS - * 35000015 * * 35700015 * JFCB IN CORE HAS DSNAME. * 36400015 * DSCB IN CORE HAS TTR POINTER. * 37100015 * * 37800015 *ATTRIBUTES - * 38500015 * * 39200015 * REUSABLE, NON-RESIDENT * 39900015 * * 40600015 *NOTES - * 41300015 * * 42000015 * REGISTERS ARE SAVED AT THE START THEN RESTORED AT THE EXIT. * 42700015 * * 43400015 * THE OPERATION OF THIS SUBROUTINE DOES NOT DEPEND UPON A PARTICULAR* 44100015 * INTERNAL REPRESENTATION OF THE EXTERNAL CHARACTER SET. * 44800015 * * 45500015 * 46200015 R15 EQU 15 RETURN CODE 46900015 R14 EQU 14 VOLID POINTER A47442 47600021 R13 EQU 13 SAVEAREA 48300015 R12 EQU 12 BASE 49000015 R11 EQU 11 SAVEAREA ADDR AND A47442 49700021 * UCB BASE ADDR A47442 49800021 R10 EQU 10 ADDR OF UCB LOOKUP TABLE A47442 49900021 R9 EQU 9 NEW TIOT BASE A47442 50000021 R8 EQU 8 ADDR OF DCB 50400015 R7 EQU 7 ADDR OF EXLST 51100015 R6 EQU 6 JFCB ADDRESS 51800015 R5 EQU 5 NUMBER VOLUMES COUNTER A47442 51900021 R3 EQU 3 BASE FOR TDIR 52100020 R2 EQU 2 WORK REGISTER A47442 52300021 R1 EQU 1 INPUT PARAMETER 52500015 R0 EQU 0 53200015 * 53900015 USING JFCBSECT,R6 54600015 USING IHADCB,R8 55300015 * 56000015 STM R14,R12,12(R13) SAVE REGISTERS 56700015 BALR R12,0 ESTABLISH 57400015 USING *,R12 ADDRESSABILITY 58100015 L R3,8(R1) GET TDIR BASE A32869 58300020 USING TDIREC,R3 A32869 58500020 L R9,0(0,R1) LOAD NEW TIOT BASE A47442 58600021 USING TIOTSECT,R9 A47442 58700021 B Z 58800015 DC C'IHKABRER' 59500015 Z DS 0H 60200015 ST R13,SAVE+4 60900015 LA R11,SAVE 61600015 ST R11,8(R13) 62300015 LR R13,R11 63000015 * 63700015 L R8,4(R1) GET DCB ADDR 64400015 L R6,ADJFCB GET ADDRESS OF JFCB 65100015 L R7,DCBEXLST GET EXLST ADDR 65800015 MVC 1(3,R7),ADJFCB+1 PUT ADDR OF JFCB INTO EXLST 66500015 * POINTED TO BY DCB 67200015 * 68600015 RDJFCB ((8)) GET JFCB FOR DSNAME 69300015 * 70000015 LA R14,JFCBVOLS GET VOLID A47442 70200021 ST R14,VOLSER PUT VOLID IN CAMLST A47442 70208021 LA R1,TIOEFSRT GET DSB PTR TO UCB A47442 70216021 SR R5,R5 INITIALIZE NUMBER OF A47442 70224021 IC R5,JFCBNVOL VOLUMES COUNTER A47442 70232021 USING UCBOB,R11 A47442 70240021 * A47442 70248021 * SEARCH UCB LIST FOR A VOL=SER THAT MATCHES THE VOL=SER IN JFCB A47442 70256021 * A47442 70264021 SEARCH L R10,16(0,0) GET CVT ADDRESS A47442 70272021 L R10,40(0,R10) ADDR OF UCB LOOKUP TABLE A47442 70280021 NXTNTRY LH R11,0(0,R10) UCB ADDRESS A47442 70288021 SLL R11,16 SHIFT OUT POSSIBLE A47442 70296021 SRL R11,16 HI-ORDER BITS A47442 70304021 CLC 0(2,R10),ENDTAB TEST FOR END OF TABLE A47442 70312021 BE NOVOL BRANCH IF TRUE. VOLUME A47442 70320021 * COULD NOT BE FOUND A47442 70328021 LTR R11,R11 TEST FOR ZERO UCB ENTRY A47442 70336021 BZ NEXTUCB BRANCH IF TRUE A47442 70344021 TM UCBTBYT3,DAC TEST FOR DIRECT ACCESS A47442 70352021 BZ NEXTUCB BRANCH IF NOT A47442 70360021 CLI UCBTBYT4,DACL TEST FOR DATA CELL A47442 70368021 BE NEXTUCB NOT SUPPORTED A47442 70376021 TM UCBFL2,X'40' TEST IF READY A47442 70384021 BO NEXTUCB BRANCH IF NOT A47442 70392021 CLC SRTEVOLI(6),0(R14) COMPARE VOLUME SER NO A47442 70400021 BNE NEXTUCB NOT EQUAL A47442 70408021 STH R11,0(0,R1) STORE UCB ADDR IN DSB A47442 70416021 LTR R9,R9 WAS USER CNT INCR IN WMS A47442 70424021 BNM NEXTSER YES, SKIP INCR USER CNT A47442 70432021 LR R2,R1 SAVE DSB PTR A47442 70440021 ENQ MF=(E,NQDQLIST) ENQ ON UCBTO INCR USE CNT A47442 70448021 SR R15,R15 A47442 70456021 IC R15,SRTEUSER GET USER COUNT FROM UCB A47442 70464021 LTR R15,R15 USER COUNT ZERO ? A47442 70472021 BP INCUSECT NO, SKIP TURNING ON A47442 70480021 * ALLOC. BIT A47442 70488021 OI SRTESTAT,SRTEALOC YES, TURN ON ALLOCATE BITA47442 70496021 INCUSECT LA R15,1(R15) ADD 1 TO USER COUNT A47442 70504021 STC R15,SRTEUSER STORE IN UCB A47442 70512021 DEQ MF=(E,NQDQLIST) DEQ ON UCB A47442 70520021 LR R1,R2 RESTORE DSB PTR A47442 70528021 NEXTSER EQU * A47442 70536021 BCTR R5,R0 DECREMENT NUMBER OF A47442 70544021 * VOLUMES COUNTER BY ONE A47442 70552021 LTR R5,R5 TEST FOR ZERO A47442 70560021 BE CONTIN A47442 70568021 LA R1,4(0,R1) POINT TO NEXT UCB ADDR A47442 70576021 * ENTRY IN DSB A47442 70584021 LA R14,6(0,R14) POINT TO NEXT VOL SERIAL A47442 70592021 B SEARCH A47442 70600021 NEXTUCB LA R10,2(0,R10) INDEX TO NEXT UCB ENTRY A47442 70608021 * IN UCB TABLE A47442 70616021 B NXTNTRY PROCESS NEXT UCB ENTRY A47442 70624021 * A47442 70632021 * VOLID CANNOT BE FOUND IN UCB TABLE A47442 70640021 * EXIT VOLID ADDR IN R15 A47442 70648021 * A47442 70656021 NOVOL LR R15,R14 A47442 70664021 B EXIT A47442 70672021 CONTIN MVI JFCBUFNO,ZEROE REQUEST NO BUFFERS A47442 70700021 CLI TDIRVOLS,ZEROE HAS A VOL SEQ NUM BEEN SAVED A40162 70800020 BZ SKIPSTC NO, THEN USE THE ONE IN JFCB A40162 70900020 MVC JFCBVLSQ+1(1),TDIRVOLS PUT VOL SEQ NUM IN JFCB A40162 71000020 XC TDIRVOLS(1),TDIRVOLS ERASE V.S.N. FOR NXT DSB READA40162 71100020 SKIPSTC EQU * A32869 71300020 * 71400015 OBTAIN CAM READ DSCB 72100015 * 72800015 LTR R15,R15 WAS READ SUCCESSFUL 73500015 BNZ EXIT IF NOT, DO NOT PERMIT OPEN 74200015 * YES, GOOD READ OF DSCB 74900015 CLC DSCB+54(3),ZERO WAS DATA SET USED 75600015 BNE GOOD TTR IS NON-ZERO, GO OPEN 76300015 CLI JFCBNVOL,X'01' TEST FOR MULTIVOL DAT SET A47445 76400021 BH GOOD IF >1, THEN MULTI-VOL A47445 76500021 * 1 VOL MEANS NO DATA A47445 76600021 B EXIT1 A47442 77000021 * 78400015 GOOD OPEN ((8),(INPUT)),TYPE=J OPEN SYSOUT DATA SET 79100015 * 79800015 EXIT1 SR R15,R15 SET TO GOOD RETURN CODE A47442 80500021 EXIT DS 0H 81200015 OUT L R13,SAVE+4 81900015 RETURN (14,12),T,RC=(15) EXIT 82600015 * 83300015 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 84000015 * 84700015 SAVE DC 18F'0' SAVEAREA 85400015 ZERO DC F'0' 86100015 * 86800015 CAM CAMLST SEARCH,JFCB,VOLSER,DSCB 87500015 ADJFCB EQU CAM+4 88200015 VOLSER EQU CAM+8 88900015 ZEROE EQU 0 RESETS JFCB BUFNO FIELD 89600015 JFCB DC 176X'00' 90300015 DS 0D 91000015 DSCB DC 350X'00' 91700015 ENDTAB DC X'FFFF' A47442 91730021 UCBRNAME DC C'Q5' A47442 91760021 SCHQNAME DC C'SYSIEFSD' A47442 91790021 NQDQLIST ENQ (SCHQNAME,UCBRNAME,E,2,SYSTEM),MF=L A47442 91820021 DAC EQU X'20' A47442 91850021 DACL EQU X'05' A47442 91880021 UCBDS DSECT A47442 91910021 IEFUCBOB A47442 91940021 IHKDSECT TDIR 92000020 EJECT 92400015 JFCBSECT DSECT 93100015 IEFJFCBN 93800015 TIOTSECT DSECT A47442 93850021 TIOCNJOB DS CL8 JOBNAME A47442 93900021 TIOCSTP DS CL8 PROCEDURE STEP NAME A47442 93950021 TIOCPST DS CL8 JOB STEP NAME A47442 94000021 TIOELNGH DS C LENGTH OF DD ENTRY A47442 94050021 TIOESTTA DS C STATUS A A47442 94100021 TIOERLOC DS CL2 POOL LOCATION A47442 94150021 TIOEDDNM DS CL8 DDNAME A47442 94200021 TIOEJFCB DS CL3 TTR OF JFCB A47442 94250021 TIOESTTC DS C STATUS C A47442 94300021 TIOESTTB DS C STATUS B A47442 94350021 TIOERSV DS C RESERVED A47442 94400021 TIOEFSRT DS CL2 UCB POINTER A47442 94450021 EJECT 94500015 DCBD DSORG=PS 95200015 END 95900015 ./ ADD SSI=01010810,NAME=IHKABXMT,SOURCE=0 XMT TITLE 'ERROR MESSAGE TRANSMITTER' 00100018 IHKABXMT CSECT 00200018 * 309000 000D 00870019 *D394200-396000 A37792 00877021 *A394600 A37792 00884021 *C388800 A37792 00891021 *D242300,312000 A45091 00897021 *A319280,212100 A45091 00903021 *A328500 A47967 00909021 *A488500-488700 A48402 00912021 *D319800,320400,321600,322200,403800-406200,536400,132500-134300 A48411 00915021 *A317470-317890,318300,319360-319680,320080-320480,321400 A48411 00921021 *A322020-322580,404200,508500,536200-536600 A48411 00927021 *D510000 A50172 00933021 *A509800,510200 A50172 00939021 *D112700,130700-131600,194600-196400,237800,240500-241400 A52749 00951021 *A130800 A52749 00957021 *C192800 A52749 00963021 *D394600 A52933 00969021 *A394000-396000,407700 A52933 00975021 *C130800 A58974 00981021 *D322240-322440 A58335 01001021 *A322240-322380 A58335 01007021 *A510300-510400 A59732 01013021 * * 01017021 * STATUS: CHANGE LEVEL 2, RELEASE 21.7 * 01021021 * * 01041021 *FUNCTION/OPERATION - THIS ROUTINE TRANSMITS AN ERROR MESSAGE TO THE * 01100018 * LINE AND SOMETIMES TO THE CENTRAL OPERATOR. WHEN FOR ONE OF 000D 01190019 * THE REASONS DESCRIBED BY THE INPUT CODES THE CENTRAL DECIDES 000D 01280019 * TO ABORT THE REMOTE INPUT AN RVI ABORT SEQUENCE IS THE TRANS- 000D 01370019 * MITTED RESPONCE RATHER THAN THE NORMAL ACK. AFTER THE RVI IS 000D 01460019 * SENT THE LINE IS READ UNTIL THE REMOTE TERMINAL TRANSMITS AN 000D 01550019 * EOT. THE ABORT MESSAGE IS THEN SENT TO THE REMOTE TERMINAL. 000D 01640019 * THE FOLLOWING MESSAGES ARE SENT TO THE CENTRAL OPERATOR REGARDLESS* 01730019 * OF THE TYPE OF TERMINAL * 01820019 * 1. MAX JOBS EXCEEDED * 01910019 * 2. OUT OF SPACE - SYSIN OR SYS1.SYSJOBQE * 02000019 * 3. DISK I/O ERROR - SYSIN OR SYS1.SYSJOBQE * 02090019 * * 02180019 *ENTRY POINT - * 02270019 * IHKABXMT - TO TRANSMIT THE ERROR MESSAGE * 02360019 * CALLING SEQUENCE - LA 1,PARAM * 02450019 * LA 13,SAVE AREA FOR THIS LINE * 02540019 * L 15,=V(IHKABXMT) * 02630019 * BALR 14,15 * 02720019 * WHERE PARAM IS A WORD CONTAINING THE LCB ADDRESS * 02810019 * 19018 02900019 * IHKABRJF - TO GENERATE AN RJENDF OR RJENDC CARD. 19018 02990019 * CALLING SEQUENCE - LA 1,PARAM 19018 03080019 * LA 13,SAVE AREA FOR THIS LINE 19018 03170019 * L 15,=V(IHKABRJF) 19018 03260019 * BR 15 19018 03350019 * WHERE PARAM IS A WORD CONTAINING THE LCB ADDRESS 19018 03440019 * LCBPARM1 IN THE LCB MUST CONTAIN A CODE 19018 03530019 * WHERE CODE IS 0 FOR RJENDC 19018 03620019 * 13 FOR RJENDF WITH LINE ERROR MESSAGE 19018 03710019 * 19 FOR RJENDF WITH ABNORMAL CENTRAL CLOSEDOWN 19018 03800019 * 65 FOR RJENDF WITH DISK ERROR JED MESSAGE 19018 03890019 * 255 FOR RJENDF WITH NO MESSAGE 19018 03980019 * 19018 04070019 * * 04160019 *INPUT - AS DESCRIBED ABOVE AND * 04250019 * LCBPARM1 IN THE LCB MUST CONTAIN AN INPUT CODE * 04340019 * WHERE CODE IS 0 FOR INVALID JOBNAME * 04430019 * 4 FOR DUPLICATE JOBNAME * 04520019 * 8 FOR NO JOB CARD * 04610019 * 12 FOR SYSIN LIMIT EXCEEDED * 04700019 * 16 FOR MAX JOBS EXCEEDED * 04790019 * 20 FOR OUT OF SPACE - SYSIN * 04880019 * 24 FOR OUT OF SPACE - SYS1.SYSJOBQE * 04970019 * 28 FOR I/O ERROR ON ASSIGN/START * 05060019 * 32 FOR I/O ERROR ON Q MGR NOT ASSIGN/START * 05150019 * 36 FOR I/O ERROR ON ALLOCATE OR SYSIN * 05240019 * 40 FOR INVALID TERMID * 05330019 * 44 FOR INVALID RJSTART OR LOGON * 05420019 * 48 FOR INVALID OPERATION - RJENDF OR RJENDC * 05510019 * 52 FOR RJSTART OR LOGON REQUIRED * 05600019 * 56 FOR UNDEFINED KEYWORD SYSIN DD 000C 05690019 * 60 FOR INVALID KEYWORD VALUE SYSIN DD DCB=BLKSIZE000C 05780019 * 64 FOR RJENDF LINE ERROR 19018 05870019 * 68 FOR RJENDF FINISHING 19018 05960019 * 72 FOR WRITE DISCONNECT 19018 06050019 * LCBPARM2 IN THE LCB MUST CONTAIN A POINTER TO CARD OR MESSAGE * 06140019 * LCBPARM3 IN THE LCB MUST CONTAIN ADDRESS OF END OF BTAM BUFFER * 06230019 * * 06320019 *OUTPUT - THE MESSAGE IS SENT. * 06410019 * * 06500019 *EXTERNAL ROUTINES - * 06590019 * IHKAADSP - DISPATCHER TO ALLOW PROCESSING OF OTHER * 06680019 * LINES WHILE WAITING FOR I/O TO* 06770019 * COMPLETE. * 06860019 * IHKCBLDM - BUILD MESSAGE TO GET A POINTER TO AN ERROR * 06950019 * MESSAGE. 000B 07040019 * IHKCDSCH - FAST TABLE SEARCH TO SEARCH FAST TABLE FOR ENTRY* 07130019 * FOR CURRENT JOB. * 07220019 * IHKCHASE - RJE EXIT TO CLOSE DOWN RJE DUE TO 19018 07310019 * IRRECOVERABLE ERROR 19018 07400019 * BTAM TO READ INPUT FROM THE LINE * 07490019 * AND TO WRITE AN ERROR MESSAGE * 07580019 * TO THE LINE. * 07670019 * * 07760019 *EXITS - NORMAL - RETURN IS MADE TO IHKABLRD WITH A RETURN CODE IN * 07850019 * REGISTER 15 AS FOLLOWS * 07940019 * 0 - ENQUEUE QUEUE ENTRY, RELBUF, RETURN TO IHKABLST * 08030019 * 4 - RELBUF, RETURN TO IHKABLST * 08120019 * 16 - WRITE RJENDF CARD AND CONTINUE 19018 08210019 * 24 - WRITE RJENDF CARD AND RETURN TO IHKABLST 19018 08300019 * * 08390019 *EXITS - ERROR - RETURN IS MADE TO IHKABLRD WITH A RETURN CODE IN * 08480019 * REGISTER 15 AS FOLLOWS * 08570019 * 8 - GENERATE RJENDF WITH ERROR MESSAGE WHICH COULD NOT BE SENT * 08660019 * 12 - GENERATE RJENDF WITH LINE ERROR MESSAGE * 08750019 * 20 - DELETE QUEUE ENTRY 19018 08840019 * * 08930019 * ABNORMAL CENTRAL CLOSEDOWN IS INITIATED WHEN AN UNRECOVERABLE 000B 09020019 * ERROR IS ENCOUNTERED. 000B 09110019 * * 09200019 *TABLES/WORK AREAS - EACH LINE HAS A LINE CONTROL BLOCK (LCB), * 09290019 * SUB-TASK CONTROL BLOCK (STCB), 452-BYTE OUTPUT BUFFER, 18-WORD * 09380019 * REGISTER SAVE AREA, A DECB AND DCB FOR LINE I/O, A DECB AND DCB * 09470019 * FOR DISK I/O, AND A BTAM BUFFER ASSOCIATED WITH IT. THE FAST * 09560019 * TABLE, THE TERMINAL DIRECTORY, AND THE CONSTANT REGION IN IHKABLRD* 09650019 * ARE USED. * 09740019 * * 09830019 *ATTRIBUTES - IT IS REENTRANT. * 09920019 * * 10010019 *NOTES - THE OPERATION OF THIS SUBROUTINE DEPENDS UPON AN INTERNAL * 10100019 * REPRESENTATION OF THE EXTERNAL CHARACTER SET WHICH IS EQUIVALENT * 10190019 * TO THE ONE USED AT ASSEMBLY TIME. THE CODING HAS BEEN ARRANGED SO* 10280019 * THAT REDEFINITION OF CHARACTER-TYPE CONSTANTS, BY REASSEMBLY, WILL* 10370019 * RESULT IN A CORRECT MODULE FOR THE NEW DEFINITION. * 10460019 SPACE 2 10550019 R0 EQU 0 10640019 R1 EQU 1 QUEUE MANAGER PARAM. AREA ADDRESS 10730019 R2 EQU 2 LCB ADDRESS 10820019 R3 EQU 3 CONSTANT DSECT ADDRESS 10910019 R4 EQU 4 MAY NOT BE USED 11000019 R5 EQU 5 BTAM BUFFER POINTER 11090019 R6 EQU 6 INTERNAL SUBROUTINE RETURN ADDRESS 11180019 R7 EQU 7 DECB ADDRESS - LINE OR DISK 11360019 R8 EQU 8 LINE DCB ADDRESS OR 11450019 * INTERNAL SUBROUTINE RETURN ADDRESS 11540019 R9 EQU 9 MESSAGE ADDRESS 11630019 R10 EQU 10 VARIABLE 11720019 R11 EQU 11 TERMINAL DIRECTORY ADDRESS 11810019 R12 EQU 12 BASE REGISTER 11900019 R13 EQU 13 SAVE AREA POINTER 11990019 R14 EQU 14 RETURN REGISTER 12080019 R15 EQU 15 ENTRY POINT REGISTER 12170019 SPACE 2 12260019 USING *,R15 USE REG. 15 AS BASE TEMPORARILY 12350019 B LRDSKIP 12440019 DC C'IHKABXMT' 12530019 LRDSKIP DS 0H 12620019 DROP R15 USE REGISTER 12 AS REAL BASE 12710019 L R2,0(R1) GET LCB ADDRESS 12800019 USING LCBDSECT,R2 BASE FOR LCB 12890019 L R1,LCBPARM1 GET INPUT CODE 12980019 L R5,LCBPARM2 GET CARD POINTER A58974 13080021 BALR R12,0 ESTABLISH BASE 13520019 USING *,R12 13610019 USING IOPARAMS,R1 BASE OF QMPA 13700019 USING LRDCONST,R3 BASE OF CONSTANT DSECT 13790019 USING IECTDECB,R7 BASE OF DECB 13880019 USING IHADCB,R8 BASE OF DCB 13970019 USING LRDUCBOB,R10 BASE OF UCB 14060019 USING TDIREC,R11 BASE OF TERMINAL DIRECTORY 14150019 USING LRDCVT,R14 14240019 BASE DS 0H 19018 14330019 L R3,LRDABXCN GET BASE OF CONSTANT DSECT 14420019 NI LCBNSWFL,LCBSWOFF TURN OFF LCB SWITCHES 14510019 L R7,LCBLDECB GET LINE DECB ADDRESS 14600019 L R11,LCBTDIR GET TERMINAL DIRECTORY POINTER 14690019 LTR R11,R11 1657 14780019 BZ ARDOFF 1657 14870019 NI TDIRSWCH+1,TDIRDIPF 1657 14960019 ARDOFF DS 0H 1657 15050019 B *+4(R1) BRANCH ON INPUT CODE 15140019 B LRDINVNM INVALID JOBNAME 15230019 B LRDDUPJB DUPLICATE JOBNAME 15320019 B LRDNOJOB NO JOB CARD 15410019 B LRDSYLMT SYSIN LIMIT EXCEEDED 15500019 B LRDFSTFL MAX JOBS EXCEEDED 15590019 B LRDSYSP2 OUT OF SPACE - SYSIN 15680019 B LRDQMSPA OUT OF SPACE - SYS1.SYSJOBQE 15770019 B LRDQMIOA I/O ERROR ON ASSIGN/START 15860019 B LRDQMIOE I/O ERROR ON Q MGR NOT ASSIGN/START 15950019 B LRDIOSYS I/O ERROR ON ALLOCATE OR SYSIN 16040019 B LRDINVTM INVALID TERMID 16130019 B LRDRJINV INVALID RJSTART OR LOGON 16220019 B LRDRJF INVALID OPERATION - RJENDC OR RJENDF 16310019 B XMTNORJS RJSTART OR LOGON REQUIRED 000C 16400019 B XMTUNDEF UNDEFINED KEYWORD SYSIN DD 000C 16490019 B LRDINVSY INVALID KEYWORD SYSIN DCB 19018 16580019 B LRDEGNJF LRDGENJF 19018 16670019 B LRDEGNRF LRDGNRFW 19018 16760019 B LRDEWRTD LRDWRTD 19018 16850019 SPACE 3 19018 16940019 LRDEGNJF DS 0H 19018 17030019 BAL R10,XMTCKSYS GENERATE RJENDF A24717 17120019 B LRDWRTJC RETURN TO LRDWRTJC 19018 17210019 SPACE 3 19018 17300019 LRDEGNRF DS 0H 19018 17390019 BAL R10,LRDGNRFW GENERATE RJENDF 19018 17480019 LRDWRTJC LA R15,LRDRTWJC RETURN TO LRDWRTJC 19018 17570019 B LRDRTLRD RETURN TO IHKABLRD 19018 17660019 SPACE 3 19018 17750019 LRDEWRTD DS 0H 19018 17840019 BAL R10,LRDWRTD WRITE DISCONNECT 19018 17930019 LA R15,LRDRTDLT RETURN TO LRDDELET 19018 18020019 B LRDRTLRD RETURN TO IHKABLRD 19018 18110019 SPACE 3 19018 18200019 * INVALID KEYWORD VALUE SYSIN DD 000C 18290019 LRDINVSY DS 0H 19018 18380019 MVI LRDBOFS+1,LRDOFS4 PUT MESSAGE OFFSET IN PARAM LIST000C 18470019 MVI LRDBPMNO,LRD18CHR SET FOR 18 PARAMETER CHARACTERS 000C 18560019 MVC LRDBPARM(10),XMTSYSIN PUT SYSIN DCB AS PARAMETER 000C 18650019 MVC LRDBPARM+10(8),72(R5) MOVE SEQUENCE NUMBER FROM 73-8000C 18740019 B XMTDELCD 000C 18830019 XMTUNDEF MVI LRDBOFS+1,LRDOFS16 PUT MESSAGE OFFSET IN PARAM LIST000C 18920019 MVI LRDBPMNO,LRD14CHR SET FOR 14 CHARACTERS 000C 19010019 MVC LRDBPARM(6),XMTSYSIN PUT SYSIN AS PARAMETER 000C 19100019 MVC LRDBPARM+6(8),72(R5) MOVE SEQUENCE NUMBER FROM 73-80000C 19190019 XMTDELCD DS 0H A52749 19280021 BAL R6,XMTDELET GENERATE DELETE CARD 000C 19370019 B LRDTSTMC SEND ERROR MESSAGE 000C 19730019 * RJSTART OR LOGON REQUIRED 19820019 XMTNORJS LTR R11,R11 CHECK FOR TERMINAL DIRECTORY PTR000C 19910019 BZ LRDRJMIS BRANCH IF NO TDIR POINTER 20000019 TM TDIRSWCH,TDIRRJSN TEST FOR RJSTART MISSING 20090019 BZ LRDRJMIS BRANCH IF RJSTART MISSING 20180019 * LOGON REQUIRED 20270019 MVI LRDBOFS+1,LRDOFS45 PUT MESSAGE OFFSET IN PARAMETER LIST 20360019 LRDRJF BAL R6,LRDERR1 EOT LINE, GET AND SEND ERROR MESSAGE 20450019 B LRDEOTCP 20540019 * RJSTART REQUIRED 20630019 LRDRJMIS MVI LRDBOFS+1,LRDOFS44 PUT MESSAGE OFFSET IN PARAMETER LIST 20720019 BAL R6,LRDERR1 SEND MESSAGE 000D 20810019 B LRDEOTCP RETURN TO LRD 000D 20900019 LRDINVNM MVI LRDBOFS+1,LRDOFS9 PUT MESSAGE OFFSET IN PARAMETER LIST 20990019 MVI LRDBPMNO,LRD8CHR SET FOR 8 PARAMETER CHARACTERS 21080019 MVC LRDBPARM(8),72(R5) MOVE SEQUENCE NUMBER FROM COLS 73-80 21170019 L R1,LCBBUFER GET ADDRESS OF JOBNAME IN QMPA A45091 21210021 B LRDJLOFF 21260019 SPACE 2 21350019 * DUPLICATE JOB NAME 21440019 LRDDUPJB L R1,LCBBUFER GET ADDRESS OF JOBNAME IN QMPA 21530019 MVI LRDBOFS+1,LRDOFS27 PUT MESSAGE OFFSET IN PARAMETER LIST 21620019 MVI LRDBPMNO,LRD17CHR SET FOR 17 PARAMETER CHARACTERS 21710019 MVC LRDBPARM(8),QMNAM PUT JOBNAME AS PARAMETER 21800019 MVI LRDBPARM+8,LRDBLANK PUT BLANK AS PARAMETER SEPARATER 21890019 MVC LRDBPARM+9(8),72(R5) MOVE SEQUENCE NUMBER FROM 73-80 21980019 LRDJLOFF NI TDIRSWCH+2,TDIRJCLF TURN OFF JCL SWITCH 22070019 MVC QMNAM(8),LRDTASK INDICATE NO FAST TABLE ENTRY 22160019 LRDTSTMC EQU * 000D 22250019 BAL R6,LRDERR SEND MESSAGE TO CPU 22340019 TM TDIRSWCH+2,TDIRMCHN TEST FOR 2780 000D 22430019 BZ LRDRT278 YES GO SET SWITCH 000D 22520019 B LRDEOTCP 22610019 SPACE 2 22700019 * NO JOB CARD 22790019 LRDNOJOB MVI LRDBOFS+1,LRDOFS28 PUT MESSAGE OFFSET IN PARAMETER LIST 22880019 MVI LRDBPMNO,LRDZERO INDICATE NO MESSAGE PARAMETERS 22970019 BAL R6,LRDERR SEND MESSAGE 000D 23060019 B LRDEOTCP RETURN 000D 23150019 SPACE 2 23240019 * SYSIN LIMIT EXCEEDED 23330019 LRDSYLMT MVI LRDBOFS+1,LRDOFS55 PUT MESSAGE OFFSET IN PARAMETER LIST 23420019 MVI LRDBPMNO,LRD8CHR SET FOR 8 PARAMETER CHARACTERS 23510019 L R1,LCBBUFER GET QUEUE MANAGER PARAM AREA ADDRESS 23600019 MVC LRDBPARM(8),QMNAM PUT JOBNAME AS PARAMETER 23690019 BAL R6,LRDCLOSE CLOSE SYSIN DATA SET AND GENERATE 23870019 * DELETE CARD 23960019 BAL R6,LRDERR GO SEND MESSAGE 000D 24320019 TM TDIRSWCH+2,TDIRMCHN TEST FOR 2780 000D 24410019 BZ LRDRT278 YES GO SET SWITCH 000D 24500019 LRDCLBLD LA R1,LRDBLDM GET ADDRESS OF PARAMETER LIST 000B 24590019 L R15,LRDCBLDM GET ENTRY POINT OF BUILD MSG 000B 24680019 BALR R14,R15 GET POINTER TO MESSAGE 000B 24770019 LRDMVMSG L R9,LCBBUFER GET ADDRESS OF LAST 79 BYTES OF 000B 24860019 LA R9,LRDMSGBF(0,R9) THE OUTPUT BUFFER 000B 24950019 BAL R10,XMTMOVE MOVE MSG AND BLANK MCS CODES 000C 25040019 LRDFLUSH EQU * FLUSH TO EOT 000B 25130019 BAL R6,LRDERR SEND MESSAGE 000D 25220019 B LRDRT278 RETURN 000D 25310019 SPACE 2 25400019 * MAX JOBS EXCEEDED - FULL FAST TABLE 25490019 LRDFSTFL MVI LRDBOFS+1,LRDOFS29 PUT MESSAGE OFFSET IN PARAMETER LIST 25580019 L R1,LCBBUFER GET QUEUE MANAGER PARAM AREA ADDRESS 25670019 MVI LRDBPMNO,LRD8CHR SET FOR 8 PARAMETER CHARACTERS 25760019 MVC LRDBPARM(8),QMNAM MOVE JOB NAME AS PARAMETER 25850019 NI TDIRSWCH+2,TDIRJCLF TURN OFF JCL SWITCH 25940019 MVC QMNAM(8),LRDTASK INDICATE NO FAST TABLE ENTRY 26030019 BAL R6,LRDWRTMG DO WRITE TO OPERATOR 000D 26120019 B LRDBREOT RETURN 000D 26210019 SPACE 2 28800018 * OUT OF SPACE - SYSIN 28900018 LRDSYSP2 NI TDIRRB,TDIREXLF TURN OFF EXLST SWITCH 29000018 MVI LRDBPMNO,LRD14CHR SET FOR 14 PARAMETER CHARACTERS 29100018 MVI LRDBOFS+1,LRDOFS54 PUT MESSAGE OFFSET IN PARAMETER LIST 29200018 MVC LRDBPARM(6),LRDGNSYS+2 PUT SYSIN BLANK AS PARAMETER 29300018 L R1,LCBBUFER GET QUEUE MANAGER PARAM AREA ADDRESS 29400018 MVC LRDBPARM+6(8),QMNAM PUT JOBNAME AS PARAMETER 29500018 LRDWTMSG LA R6,LRDBRCLS SET RETURN ADDRESS 29600018 LRDWRTMG LA R1,LRDBLDM GET ADDRESS OF PARAMETER LIST 29700018 L R15,LRDCBLDM GET ENTRY POINT OF BUILD MESSAGE 29800018 BALR R14,R15 TO GET POINTER TO MESSAGE 29900018 L R9,LCBBUFER GET ADDRESS OF LAST 79 BYTES OF THE 30000018 LA R9,LRDMSGBF(R9) OUTPUT BUFFER 30100018 BAL R10,XMTMOVE MOVE MSG AND BLANK MCS CODES 000C 30200018 SVC 35 WTO - WRITE MESSAGE TO CENTRAL 30300018 LTR R11,R11 CHECK FOR TERMINAL DIRECTORY POINTER 30400018 BCR 8,R6 RETURN IF NO TDIR POINTER 30500018 OI TDIRSWCH+2,TDIRLWRN TURN ON BRANCH TO LWR SWITCH 30600018 BR R6 30700018 LRDBRCLS TM TDIRSWCH,TDIRSYSN TEST DD DATA AND DD * SWITCHES 30800018 LA R6,LRDBREOT SET RETURN 000D 30860019 BZ XMTDELET BRANCH IF BOTH OFF 000D 30920019 BAL R6,LRDCLOSE CLOSE SYSIN DATA SET AND GENERATE 31000018 * A DELETE CARD 31100018 LRDBREOT EQU * 000D 31260019 BAL R6,LRDSNMSG SEND MESSAGE TO REMOTE 000D 31320019 TM TDIRSWCH+2,TDIRMCHN TEST FOR 2780 000D 31380019 BZ LRDRT278 YES GO SET RETURN SWITCH 000D 31440019 B LRDEOTCP RETURN TO IHKABLRD 000D 31500019 SPACE 2 31560019 LRDCLOSE L R7,LCBDDECB GET DISK DECB ADDRESS 31620019 L R8,DECDCBAD GET DISK DCB ADDRESS 31680019 CLOSE ((8)) CLOSE SYSIN DATA SET 31740019 L R10,LCBBUFER SET REG 10 TO START A48411 31747021 LA R10,LRDQMCHN(R10) OF JCL-JECL BUFFER A48411 31754021 MVI 4(R10),LRDBLANK BLANK OUT BUFFER A48411 31761021 MVC 5(79,R10),4(R10) A48411 31768021 MVC 19(14,R10),LRDSMFCD MOVE JCL TO BUFFER A48411 31775021 MVC 4(2,R10),LRDSLASH INSERT // A48411 31782021 MVI LRDCDIND(R10),LRD1CRD INDICATE ONE CARD A48411 31789021 XMTDELET L R7,LCBLDECB GET LINE DECB ADDRESS 000C 31800019 NI TDIRSWCH,TDIRSYSF RESET DD * AND DD DATA SW A48411 31830021 L R10,LCBBUFER SET REGISTER 10 TO BEGINNING OF 31860019 LA R10,LRDQMCHN(R10) JECL AND JCL BUFFER 31920019 SR R4,R4 GET BUFFER INDEX A45091 31928021 IC R4,LRDCDIND(R10) A48411 31936021 LR R8,R10 A48411 31944021 CLI LRDCDIND(R10),X'10' CHECK NO CARD INDICATOR A48411 31952021 BE XMTDEL1 YES - SKIP ADJUSTMENT A48411 31960021 AR R10,R4 NO - POINT R10 TO BFR + 80 A48411 31968021 XMTDEL1 MVC 4(13,R10),LRDCANCL PUT .. DELETE J= IN BUFFER A48411 32008021 MVC 17(67,R10),16(R10) BLANK COLS. 15 - 80 A48411 32048021 L R1,LCBBUFER GET QUEUE MANAGER PARAM AREA ADDRESS 32100019 MVC 16(8,R10),QMNAM PUT JOBNAME ON DELETE CARD A48411 32140021 CLC QMNAM,LRDTASK IS 'JOBNAME' RJETASK 000D 32180019 BCR 8,R6 YES, DO NOT DELETE 000D 32200019 X R4,LRDDEC80 CHANGE BFR INDEX $ INDICATOR A48411 32202021 STC R4,LRDCDIND(R8) TO SHOW 1 MORE CARD IN BFR A48411 32204021 BCR 7,R6 RETURN IF BFR NOT FULL A48411 32206021 SPACE 32208021 XMTWRASG LR R1,R11 STORE THE RELATIVE TDIR PTR A48411 32210021 S R1,LRDCDTDR (TDIR-START MINUS THIS-TDIR) A48411 32212021 ST R1,164(R8) IN OUTPUT BFR A48411 32214021 L R1,LCBBUFER GET ADDRESS OF QMPA & SET UP: A48411 32216021 MVI QMPOP,QMWRTA WRITE/ASSIGN CODE A48411 32218021 MVI QMPCM,X'11' WT 1 RCD & ASSUGB A48411 32220021 ST R8,QMPCA ADDRESS OF OUTPUT BFR A48411 32222021 LR R10,R9 SAVE REG 9 A58335 32224021 BAL R9,LRDQMNGR ASSIGN/START A58335 32231021 LR R9,R10 RESTORE REG 9 A58335 32238021 BNZ LRDQMIOE A48411 32246021 L R1,LCBBUFER SET UP QMPA A48411 32248021 L R10,QMCHN A48411 32250021 ST R10,QMPEX A48411 32252021 L R10,QMPCA A48411 32254021 ST R10,QMCHN A48411 32256021 MVI LRDCDIND(R8),LRDNOCRD RESET JCL BFR INDCTR A48411 32258021 BR R6 32280019 SPACE 2 32340019 * OUT OF SPACE - SYS1.SYSJOBQE 32400019 LRDQMSPA LTR R11,R11 CHECK FOR TERMINAL DIRECTORY POINTER 32460019 BZ LRDQMSPC BRANCH IF NO TDIR POINTER 32520019 OI TDIRSWCH,TDIRRJFN TURN ON NO RJENDF SWITCH 32580019 LRDQMSPC MVI LRDBOFS+1,LRDOFS54 PUT MESSAGE OFFSET IN PARAMETER LIST 32640019 MVI LRDBPMNO,LRD13CHR SET FOR 13 PARAMETER CHARACTERS 32700019 MVC LRDBPARM(13),LRDSYSJQ PUT SYS1.SYSJOBQE AS PARAMETER 32760019 LRDQMMSG BAL R6,LRDWRTMG WRITE MESSAGE TO CENTRAL 32820019 OI LCBNSWFL,LCBRET8 ENSURE RETURN TO LRDRELBF A47967 32850021 BAL R6,LRDSNMSG 32880019 B LRDRELBF 32940019 SPACE 2 33000019 * I/O ERROR ON ASSIGN/START 33060019 LRDQMIO2 DS 0H TAG FOR BRANCHING 000B 33120019 LRDQMIOA DS 0H TAG FOR BRANCHING 000B 33180019 USING IHKZZAVT,R14 CHANGE REG TO DSECT RJE AVT 000B 33240019 L R14,LRDZZAVT GET BASE FOR RJE COMM AREA 000B 33300019 L R1,IHKZZRCS GET RJE COMM SWITCH ADDRESS 000B 33360019 OI 0(R1),LRD17QER SET QMGR I/O ERROR INDICATOR IN 000B 33420019 * - RJE COMMUNICATIONS SWITCH 000B 33480019 LRD17QER EQU X'01' PERMANENT GMGR I/O ERR INDICATOR000B 33540019 L R15,IHKZZASE GET RJE EXIT ENTRY POINT 000B 33600019 BR R15 INITIATE ABNORMAL CLOSEDOWN 000B 33660019 SPACE 2 33720019 SPACE 2 33780019 * I/O ERROR ON Q MGR NOT ASSIGN/START 33840019 LRDQMIOE OI TDIRSWCH,TDIRRJFN TURN ON NO RJENDF SWITCH 33900019 MVI LRDBOFS+1,LRDOFS67 PUT MESSAGE OFFSET IN PARAMETER LIST 33960019 L R1,LCBBUFER GET QUEUE MANAGER PARAM AREA ADDRESS 34020019 CLC QMNAM(8),LRDTASK CHECK FOR JOBNAME 34080019 BNE LRDJOBPM BRANCH IF FOUND 34140019 MVI LRDBPMNO,LRDZERO SET FOR NO PARAMETER CHARACTERS 34200019 B LRDQMMSG WRITE MESSAGE TO CENTRAL AND REMOTE 34260019 LRDJOBPM MVI LRDBPMNO,LRD8CHR SET FOR 8 PARAMETER CHARACTERS 34320019 L R1,LCBBUFER GET QUEUE MANAGER PARAM AREA ADDRESS 34380019 MVC LRDBPARM(8),QMNAM PUT JOBNAME AS PARAMETER 34440019 L R15,LRDCDSCH GET ENTRY POINT OF FAST TABLE SEARCH 34500019 BALR R14,R15 RETURNS TABLE ENTRY ADDR IN REG. 1 34560019 USING FASTAB,R1 34620019 MVI FASTNAME,LRDINACT MAKE FAST TABLE ENTRY INACTIVE 34680019 USING IOPARAMS,R1 RESET BASE OF QMPA 34740019 B LRDQMMSG WRITE MESSAGE TO CENTRAL AND REMOTE 34800019 SPACE 2 34860019 * I/O ERROR ON ALLOCATE OR 34920019 * SYSIN DATA SET 34980019 LRDIOSYS MVI LRDBOFS+1,LRDOFS68 PUT MESSAGE OFFSET IN PARAMETER LIST 35040019 MVI LRDBPMNO,LRD24CHR SET FOR 24 PARAMETER CHARACTERS 35100019 L R10,LRDUCBAD GET ADDRESS OF UCB ADDRESS 35160019 L R10,0(R10) GET UCB ADDRESS 35220019 USING LRDUCBOB,R10 SET BASE FOR UCB 35280019 MVC LRDBPARM(6),SRTEVOLI PUT VOLUME SERIAL NUMBER AS PARAM 35340019 MVI LRDBPARM+6,LRDBLANK PUT BLANK AFTER VOLUME SERIAL 35400019 L R1,LCBBUFER GET QUEUE MANAGER PARAM AREA ADDRESS 35460019 MVC LRDBPARM+7(8),QMNAM PUT JOBNAME AS PARAMETER 35520019 MVI LRDBPARM+15,LRDBLANK PUT BLANK AFTER JOBNAME 35580019 MVC LRDBPARM+16(8),LCBDDNAM PUT DDNAME AS PARAMETER 35640019 B LRDWTMSG WRITE MESSAGE TO CENTRAL AND REMOTE 35700019 SPACE 2 35760019 * TWO LINES ARE USING THE SAME TERMID 35820019 LRDINVTM MVI LRDBOFS+1,LRDOFS6 PUT MESSAGE OFFSET IN PARAMETER LIST 35880019 MVI LRDBPMNO,LRD16CHR SET FOR 16 MESSAGE PARAMETER CHARS. 35940019 MVC LRDBPARM(8),LRDRJSTT STORE RJSTART AS COMMAND PARAMETER 36000019 MVC LRDBPARM+8(8),72(R5) STORE SEQUENCE NUMBER - COLS. 73-80 36060019 SR R11,R11 SET FOR NO TDIR POINTER 36120019 LRDINVCP BAL R6,LRDERR SEND MESSAGE TO CPU 36180019 B LRDEOTCP 36240019 SPACE 2 36300019 * INVALID RJSTART OR LOGON - SEND 36360019 * COMMAND INTERPRETER'S MESSAGE 36420019 LRDRJINV L R1,8(R5) GET ADDRESS OF ERROR MESSAGE 36480019 BAL R6,LRDSTMSG 36540019 B LRDEOTCP 36600019 SPACE 2 36660019 LRDERR1 MVI LRDBPMNO,LRDZERO INDICATE NO MESSAGE PARAMETERS 36720019 LRDERR LA R1,LRDBLDM GET ADDRESS OF PARAMETER LIST 36780019 L R15,LRDCBLDM GET ENTRY POINT OF BUILD MESSAGE 36840019 BALR R14,R15 TO GET POINTER TO MESSAGE 36900019 LRDSTMSG L R9,LCBBUFER GET ADDRESS OF LAST 79 BYTES OF THE 36960019 LA R9,LRDMSGBF(R9) OUTPUT BUFFER 37020019 BAL R10,XMTMOVE MOVE MSG AND BLANK MCS CODES 000C 37080019 LRDSNMSG EQU * 37140019 MVI 14(R9),LRDCHAR1 INDICATE REMOTE MESSAGE 37200019 MVC XMTZERO(XMTHREE,R9),LRDSTXES MOVES DATA LINK CHAR 000D 37260019 MVI SIXTHEE(R9),LRDETX PUT ENDING CHAR ON RECORD 000D 37320019 LTR R11,R11 CHECK FOR TERMINAL DIRECTORY POINTER 37380019 BZ LRDNOTDR BRANCH IF NO TDIR POINTER 37440019 NI TDIRSWCH+1,TDIRDIPF TURN OFF DISCONTINUED INPUT SWITCH 37500019 LRDNOTDR EQU * 000D 37560019 L R11,LCBTDIR GET TERMINAL DIRECTORY POINTER AGAIN 37620019 L R1,LCBLDECB LOADS DECB POINTER 000D 37680019 LR R7,R1 SET DSECT BASE 000D 37740019 READ (R1),TRV,MF=E WRITE RVI ABORT AND READS TO EOT 000D 37800019 BAL R10,LRDSIOER CHECK IF I/O WAS GOOD 000D 37860019 B LRDOKCK GO CHECK FOT EOT 000D 37920019 LRDTRYAG READ (R1),TT,MF=E NO EOT YET DO ANOTHER READ 000D 37980019 BAL R10,LRDSIOER CHECK IF I/O WAS GOOD 000D 38040019 LRDOKCK L R10,DECAREA LOADS BUFFER ADDRESS 000D 38100019 CLI 0(R10),LRDEOTCR CHECK FOR EOT NO TRY AGAIN 000D 38160019 BNE LRDTRYAG YES WRITE MESSAGE 000D 38220019 L R8,DECAREA LOADS BUFFER ADDRESS 000D 38280019 CLI LCBTYPLN,LCBSWTCH TEST FOR SWITCHED LINE 000D 38340019 BE XMTWRENQ YES GO DO WRITE ENQ 000D 38400019 CLI LCBTYPLN,LCBMULPT CHECK FOR MULTI DROP LINE 000D 38460019 BNE LRDWRITE NO SKIP LOAD OF DEFINE TERM LIST 000D 38520019 LA R10,TDIRDFTM LOADS DEFINE TERMINAL LIST PTR 000D 38580019 LRDWRITE EQU * 000D 38640019 WRITE (R1),TI,,(R9),64,(R10),MF=E 000D 38700019 BAL R10,LRDSIOER CHECK IF I/O WAS GOOD 000D 38760019 WRITE (R1),TN,MF=E WRITE EOT 000D 38820019 XMTMOBIL BAL R10,LRDSIOER GO CHECK FOR GOOD I/O A37792 38880021 ST R8,DECAREA RESTORE BUFFERV ADDRESS 000D 38940019 LH R8,XMTORLNG RELOAD ORIGINAL 000D 39000019 STH R8,DECLNGTH PUT IT IN DECB 000D 39060019 BR R6 RETURN TO CALLER 000D 39120019 XMTWRENQ EQU * 000D 39180019 WRITE (R1),TQ,MF=E 000D 39240019 BAL R10,LRDSIOER CHECK FOR GOOD I/O 000D 39300019 WRITE (R1),TT,,(R9),64,MF=E 000D 39360019 BAL R10,LRDSIOER CHECK FOR GOOD I/O A52933 39400021 ST R8,DECAREA RESTORE BUFFER ADDRESS A52933 39440021 LH R8,XMTORLNG RELOAD ORIGINAL LENGTH A52933 39480021 STH R8,DECLNGTH STORE IN DECB A52933 39520021 TM LCBNSWFL,LCBRET8 TEST FOR RETURN TO RELBUF A52933 39560021 BO LRDRELBF A52933 39600021 XMTRET04 LA R15,XMTCOD12 SET RETURN CODE FOR LRD 000D 39660019 B LRDRTLRD SET AND RETURN TO LRD 000D 39720019 LRDSIOER LTR R15,R15 TEST FOR SUCCESSFUL START OF WRITE 39780019 BC 7,LRDBADWT BRANCH IF UNSUCCESSFUL START 39840019 L R1,LCBLDECB LOAD LINR DECB 000D 39900019 L R15,LRDAADSP CALL DISPATCHER WHICH HAS A 39960019 BALR R14,R15 MULTIPLE WAIT 40020019 CLI DECSDECB,LRD7F TEST FOR SUCCESSFUL END OF WRITE 40080019 BNE LRDBADWT BRANCH IF UNSUCCESSFUL COMPLETION 40140019 BR R10 40200019 SPACE 2 40260019 LRDEOTCP SR R15,R15 SET RETURN TO LRDEOT IN IHKABLRD 40320019 B LRDRTLRD A48411 40420021 SPACE 2 40680019 LRDRELBF LA R15,LRDRTREL SET RETURN FOR LRDRELBF IN IHKABLRD 40740019 OI LCBNSWFL,LCBERRSW TURN ON ERROR SWITCH A52933 40770021 B LRDRTLRD RETURN TO IHKABLRD 40800019 SPACE 2 40860019 LRDBADWT LA R15,LRDRTBWT SET RETURN FOR RJENDF WITH ERROR MSG 40920019 L R11,LCBTDIR LOAD TDIR POINTER 000D 40980019 LTR R11,R11 TEST IF WE HAVE A POINTER 000D 41040019 BZ LRDSETER NO DONT BUILD ERROR MESSAGE 000D 41100019 B LRDRTLRD RETURN TO IHKABLRD 41160019 SPACE 2 41220019 LRDBDRD LA R15,LRDRTBRD SET RETURN FOR RJENDF LINE ERROR 41280019 B LRDRTLRD RETURN TO IHKABLRD 41340019 LRDRT278 LTR R11,R11 CHECK FOR TDIR POINTER 000D 41400019 BZ LRDSETER NO POINTER SKIP TEST 000D 41460019 TM TDIRSWCH+2,TDIRLWRN TEST FOR RETURN TO LWR 000D 41520019 BO LRDNOEOT YES SET CODE AND RETURN TO LWR 000D 41580019 LRDSETER EQU * 41640019 OI LCBNSWFL,LCBERRSW TURN ON ERROR SWITCH 41700019 TM LCBNSWFL,LCBRET8 TEST FOR RETURN TO LRDRELBF 41760019 BO LRDRELBF BRANCH IF SO 41820019 TM LCBNSWFL,LCBABEND TEST FOR ABEND AFTER SENDING MESSAGE 41880019 BO LRDQMIO2 BRANCH IF SO 41940019 B LRDEOTCP RETURN TO IHKABLRD 42000019 LRDNOEOT OI TDIRSWCH+1,TDIRWRTN SET RETURN SWITCH TO LWR 000D 42060019 B LRDSETER RETURN 000D 42120019 SPACE 2 42180019 XMTMOVE DS 0H SUBROUTINE TO MOVE MSG & BLANK 000C 42240019 * OUT ANY MCS CODE PRESENT 000C 42300019 MVC 11(60,R9),4(R1) MOVE MESSAGE TO BUFFER 000C 42360019 LH R15,0(R1) GET LENGTH+4 FROM WTO SETUP 000C 42420019 LA R15,7(R9,R15) GET ADDRESS OF MCS CODES 000C 42480019 MVC 0(4,R15),XMTBLANK BLANK OUT MCS CODES 000C 42540019 BR R10 RETURN TO MAIN CODE 000C 42600019 SPACE 3 19018 42660019 LRDASGS2 L R1,LCBBUFER GET QUEUE MANAGER PARAM. AREA 19018 42720019 MVC QMNAM(8),LRDTASK PUT RJETASK AS JOBNAME 19018 42780019 XC QMFLT(23),QMFLT CLEAR NEXT SIX WORDS OF QMPA 19018 42840019 LA R9,QMPCA GET ADDRESS OF EXTERNAL AREA 19018 42900019 ST R9,QMPCL STORE IN LAST WORD OF QMPA 19018 42960019 MVI QMPOP,QMASGS STORE ASSIGN/START CODE 19018 43020019 MVI QMTPY,LRDSYSIN SET FOR SYSIN QUEUE 19018 43080019 MVI QMPCM,LRD2TTRS TO ASSIGN TWO TTR'S 19018 43140019 BAL R9,LRDQMNGR ASSIGN/START 19018 43200019 BC 7,LRDQMIOA BRANCH IF I/O ERROR 19018 43260019 L R1,LCBBUFER GET QUEUE MANAGER PARAM. AREA 19018 43320019 L R9,QMPEX GET TTR FOR SECOND WRITE 19018 43380019 ST R9,QMCHN STORE AS CHAINING FROM FIRST 19018 43440019 L R9,QMPCA GET TTR FOR FIRST WRITE 19018 43500019 ST R9,QMPEX STORE AS TTR FOR FIRST WRITE 19018 43560019 LA R8,QMCHN GET JECL AND JCL BUFFER ADDRE 19018 43620019 LA R4,0 TO INDEX JECL AND JCL BUFFER 19018 43680019 MVI LRDCDIND(R8),LRDNOCRD INDICATE NO CARDS IN BUFFER 19018 43740019 NI LCBNSWFL,LCBNQOFF INDICATE NO CARDS TO ENQUEUE 19018 43800019 BR 10 19018 43860019 SPACE 1 19018 43920019 LRDQMNGR ST R1,LCBPARM1 STORE QMPA ADDRESS FOR IHKQMN 19018 43980019 USING IHKZZAVT,R14 SET UP ADDRESSABILITY 19018 44040019 L R14,LRDZZAVT GET AVT ADDRESS 19018 44100019 L R15,IHKZZRCS GET ADDRESS OF SWITCHES 19018 44160019 TM 1(R15),XMTMFTON CHECK CONTROL PROGRAM TYPE 19018 44220019 BZ XMTMVT IF MVT, GO TO SUBTASK 19018 44280019 L R15,IHKZZSSS IF MFT, GO TO QMSSS DIRECTLY 19018 44340019 BALR R14,R15 WITHOUT SUBTASK AS MIDDLEMAN 19018 44400019 LTR R15,R15 TEST RETURN CODE 19018 44460019 BR R9 RETURN 19018 44520019 XMTMVT DS 0H MVT ONLY 19018 44580019 L R7,LCBDDECB GET ADDRESS OF DISK DECB 19018 44640019 XC DECSDECB(4),DECSDECB CLEAR ECB 19018 44700019 ST R7,LCBPARM2 STORE ECB ADDRESS FOR IHKQMNG 19018 44760019 LA R0,LCBPARM1 GET ADDRESS OF PARAMETER LIST 19018 44820019 LA R1,LCBQMECB GET ADDRESS OF ECB FOR IHKQMN 19018 44880019 POST (1),(0) POST THE ECB FOR IHKQMNGR 19018 44940019 LR R1,R7 GET ADDRESS OF DISK ECB 19018 45000019 L R15,LRDAADSP GET ADDRESS OF DISPATCHER 19018 45060019 BALR R14,R15 HAS MULTIPLE WAIT 19018 45120019 CLI DECSDECB+3,LRDZERO CHECK RETURN CODE 19018 45180019 BR R9 19018 45240019 SPACE 2 19018 45300019 * LINE FAILURE 19018 45360019 LRDUSER L R9,LRDCDSOC GET RJETABLE ADDRESS 19018 45420019 L R1,LCBLDECB GET DECB ADDRESS FOR USER 19018 45480019 L R15,LRDUSREX(R9) GET LINE ERROR USER EXIT ADDR 19018 45540019 BALR R14,R15 BRANCH TO USER EXIT OR DUMMY 19018 45600019 LRDWMSRT NI TDIRSTAT,TDIRNQJM TURN OFF ENQUEUE JOBS AND ENQ 19018 45660019 * MESSAGES BITS 19018 45720019 OI TDIRSTAT,TDIRDQNN SET DEQUEUE NOTHING BIT 19018 45780019 OI LCBNSWFL,LCBRJNDF INDICATE RJENDF GENERATED 19018 45840019 NI TDIRSWCH,TDIRRJLF TURN OFF RJSTART AND LOGON SW 19018 45900019 NI TDIRSWCH+2,TDIRLWRF TURN OFF BRANCH TO LWR SWITCH 19018 45960019 L R14,LRDZZAVT GET BASE OF AVT DSECT 19018 46020019 L R15,IHKZZECB GET ADDRESS OF ECBLIST OF IHK 19018 46080019 MVI 0(R15),LRDPOST POST THE MESSAGE ECB 19018 46140019 MVI 4(R15),LRDPOST POST THE JOB ECB 19018 46200019 USING LRDCVT,R14 RESET BASE OF CVT 19018 46260019 BR R10 19018 46320019 SPACE 1 19018 46380019 XMTCKSYS DS 0H A24717 46440019 TM TDIRSWCH,TDIRSYSN CHECK SYSIN SWITCHES A24717 46500019 BZ LRDGENJF BRANCH IF BOTH OFF A24717 46560019 LR R9,R10 SAVE LINK REGISTER A24717 46620019 BAL R6,LRDCLOSE CLOSE SYSIN DATA SET A24717 46680019 LR R10,R9 RESTORE LINK REGISTER A24717 46740019 LRDGENJF MVI LCBPARM3+3,LRDOFS13 GET LINE ERROR MESSAGE OFFSET 19018 46800019 SPACE 1 19018 46860019 L R1,LCBBUFER GET QMPA ADDRESS 19018 46920019 LA R8,QMCHN GET DISK BUFFER ADDRESS 19018 46980019 LRDGNRJF LR R9,R8 GET ADDRESS OF JECL AND JCL B 19018 47040019 AR R9,R4 ADD BUFFER INDEX (0 OR 80) 19018 47100019 MVC 4(10,R9),LRDDOTS PUT '.. RJENDF ' ON CARD 19018 47160019 MVC LRDBOFS+1(1),LCBPARM3+3 GET MESSAGE OFFSET 19018 47220019 MVI LRDBPMNO,LRDZERO SET FOR NO PARAMETER CHARACTE 19018 47280019 LA R1,LRDBLDM GET ADDRESS OF PARAMETER LIST 19018 47340019 L R15,LRDCBLDM GET ENTRY POINT OF BUILD MESS 19018 47400019 BALR R14,R15 TO GET POINTER TO MESSAGE 19018 47460019 MVC 14(60,R9),4(R1) PUT MESSAGE ON RJENDF CARD 19018 47520019 LRDGNRFW MVI 74(R9),LRDBLANK PUT BLANK IN COLUMN 71 19018 47580019 MVC 75(9,R9),74(R9) PUT BLANKS IN COLUMNS 72-80 19018 47640019 MVI 17(R9),LRDCHAR1 INDICATE REMOTE MESSAGE 19018 47700019 LRDGNRFB X R4,LRDDEC80 SET JCL BUFFER INDEX TO 80 OR 19018 47760019 L R1,LCBBUFER GET QMPA ADDRESS 19018 47820019 LA R8,QMCHN GET DISK BUFFER ADDRESS 19018 47880019 STC R4,LRDCDIND(R8) TO INDICATE 1 OR 2 CARDS IN B 19018 47940019 * (80 MEANS 1 CARD, 0 MEANS 2 C 19018 48000019 CLI LRDBOFS+1,LRDABCLS CHECK FOR WARMSTART RJENDF 19018 48060019 BCR 8,R10 IF SO, DO NOT DISCONNECT 19018 48120019 XC LCBTDIR,LCBTDIR ZERO LCBTDIR A22277 48180019 XC TDIRLCB,TDIRLCB INSURE LCBTDIR=TDIRLCB=0 A24703 48240019 LRDWRTD CLI LCBTYPLN,LCBSWTCH CHECK FOR SWITCHED LINE 19018 48300019 BCR 7,R10 RETURN IF NON-SWITCHED LINE 19018 48360019 L R7,LCBLDECB GET ADDRESS OF LINE DECB 19018 48420019 WRITE (7),TD,MF=E DISCONNECT 19018 48480019 LTR R11,R11 CHECK FOR TDIR POINTER 19018 48540019 BZ LRDNOTDI BRANCH IF NO TDIR POINTER 19018 48600019 OI TDIRSWCH+1,TDIRDABN TURN ON DISABLE SWITCH 19018 48660019 LRDNOTDI LR R1,R7 GET LINE ECB ADDRESS 19018 48720019 L R15,LRDAADSP CALL DISPATCHER WHICH HAS A 19018 48780019 BALR R14,R15 MULTIPLE WAIT 19018 48840019 LTR R11,R11 CHECK FOR TDIR POINTER A48402 48850021 BCR 8,R10 BRANCH IF NO TDIR POINTER A48402 48860021 NI TDIRSWCH+1,TDIRDABF TURN OFF DISABLE SWITCH A48402 48870021 BR R10 19018 48900019 SPACE 2 19018 48960019 * 19018 49020019 **************************************************************** 19018 49080019 * 19018 49140019 * ENTRY POINT TO GENERATE RJENDF OR RJENDC 19018 49200019 * 19018 49260019 **************************************************************** 19018 49320019 * 19018 49380019 SPACE 2 19018 49440019 ENTRY IHKABRJF TO GENERATE RJENDF OR RJENDC 19018 49500019 USING *,R15 USE REG. 15 AS BASE TEMPORARI 19018 49560019 IHKABRJF L R12,XMTBASE GET ADDRESS OF REAL BASE 19018 49620019 DROP R15 USE REGISTER 12 AS BASE AGAIN 19018 49680019 L R2,0(R1) GET LCB ADDRESS 19018 49740019 XC LCBWORKA,LCBWORKA TO INDICATE ENTRY AT IHKABRJF 19018 49800019 L R3,LRDABXCN GET BASE FOR CONSTANTS 19018 49860019 L R11,LCBTDIR GET TERMINAL DIRECTORY POINTE 19018 49920019 L R1,LCBPARM1 GET INPUT CODE 19018 49980019 ST R1,LCBPARM3 SAVE INPUT CODE 19018 50040019 LTR R1,R1 TEST INPUT CODE 19018 50100019 BZ LRDRJC BRANCH IF ZERO - RJENDC CARD 19018 50160019 CLI LCBPARM3+3,LRDABCLS CHECK FOR RJENDF WITH ABNORMA 19018 50220019 * CENTRAL CLOSEDOWN MESSAGE 19018 50280019 BE LRDWRMST BRANCH IF SO 19018 50340019 CLI LCBPARM3+3,LRDNOMSG CHECK FOR RJENDF WITH NO MSG 19018 50400019 BE LRDRJFBL BRANCH IF SO 19018 50460019 BAL R10,LRDUSER GO TO USER EXIT AND SET RJEND 19018 50520019 LRDRJFAB BAL R10,LRDTSTSP CHECK IF QUEUE ENTRY AVAILABL 19018 50580019 BAL R10,LRDASGS2 ASSIGN A NEW QUEUE ENTRY 19018 50640019 BAL R10,LRDGNRJF GENERATE RJENDF CARD 19018 50700019 LRDWTNQ DS 0H 19018 50760019 LA R15,LRDRTRLS SET TO RETURN TO IHKABLST 19018 50820019 LRDRTLRD DS 0H A48411 50850021 L R14,XMTADRET GET RETURN ADDRESS 19018 50880019 L R12,LRDABLRD GET BASE OF LRD 19018 50940019 L R3,LCBBUFER A50172 50980021 LA R3,LRDQMCHN(R3) A50172 51020021 L R7,LCBDDECB GET DISK DECB ADDRESS A59732 51030021 L R8,DECDCBAD GET DISK DCB ADDRESS A59732 51040021 BR R14 RETURN TO IHKABLRD 19018 51060019 SPACE 2 19018 51120019 LRDWRMST BAL R10,LRDWMSRT SET RJENDF BITS BUT DO NO GO 19018 51180019 B LRDRJFAB THE USER EXIT 19018 51240019 SPACE 2 19018 51300019 * GENERATE RJENDF WITH NO MESSA 19018 51360019 * FOR 2780 ON SWITCHED LINE 19018 51420019 LRDRJFBL BAL R10,LRDWMSRT SET RJENDF BITS 19018 51480019 BAL R10,LRDTSTSP CHECK IF QUEUE ENTRY AVAILABL 19018 51540019 BAL R10,LRDASGS2 ASSIGN A NEW QUEUE ENTRY 19018 51600019 MVC 4(10,R8),LRDDOTS PUT '.. RJENDF ' ON CARD 19018 51660019 MVC 14(70,R8),13(R8) PUT BLANKS IN COLUMNS 11-80 19018 51720019 BAL R10,LRDGNRFB 19018 51780019 B LRDWTNQ 19018 51840019 SPACE 2 19018 51900019 LRDRJC NI TDIRSTAT,TDIRNQJF TURN OFF ENQUEUE JOBS BIT 19018 51960019 OI TDIRSTAT,TDIRDQMN TURN ON DEQUEUE MESSAGES ONLY 19018 52020019 NI TDIRSWCH,TDIRRJLF TURN OFF RJSTART AND LOGON SW 19018 52080019 BAL R10,LRDTSTSP CHECK IF QUEUE ENTRY AVAILABL 19018 52140019 BAL R10,LRDASGS2 ASSIGN A NEW QUEUE ENTRY 19018 52200019 MVC 4(10,R8),LRDDOTRC PUT '.. RJENDC ' ON CARD 19018 52260019 MVC 14(70,R8),13(R8) PUT BLANKS IN COLUMNS 11-80 19018 52320019 L R9,LCBDDECB GET ADDRESS OF DISK ECB 19018 52380019 ST R9,16(R8) STORE ON CARD 19018 52440019 MVI LRDCDIND(R8),LRD1CRD INDICATE ONE CARD IN BUFFER 19018 52500019 B LRDWTNQ TO WRITE/ENQUEUE 19018 52560019 SPACE 2 19018 52620019 LRDTSTSP L R14,CVTPTR GET ADDRESS OF CVT 19018 52680019 L R15,CVTJOB GET ADDRESS OF Q MGR RESIDENT 19018 52740019 USING LRDQMRES,R15 19018 52800019 LH R9,QMNOTM GET NUMBER OF AVAIL. LOGICAL 19018 52860019 SH R9,QMTBT SUBTRACT NUMBER OF LOGICAL TR 19018 52920019 * RESERVED FOR INITIATORS 19018 52980019 BCR 2,R10 RETURN IF QUEUE ENTRY AVAILAB 19018 53040019 LRDNOTQD LA R15,LRDCDNRC SET RETURN CODE FOR RJENDC OR 19018 53100019 * NOT QUEUED 19018 53160019 LRDRETLS L R14,LRDABLST GET RETURN ADDRESS OF LINE SC 19018 53220019 BR R14 RETURN TO LINE SCHEDULER 19018 53280019 SPACE 4 19018 53340019 XMTBASE DC A(BASE) BASE OF MODULE 19018 53400019 XMTADRET DC V(IHKABRET) 19018 53460019 SPACE 2 53520019 XMTBLANK DC CL4' ' BLANKS FOR BLANKING MCS CODES 000C 53580019 LRDSMFCD DC C'SPACE=(80,(1))' A48411 53620021 LRDCANCL DC C'.. DELETE J= ' A48411 53660021 XMTSYSIN DC C'SYSIN DCB ' FOR PARAMETER IN MESSAGE 000C 53700019 LRDSYSJQ DC C'SYS1.SYSJOBQE' FOR OUT OF SPACE MESSAGE 53760019 LRDSTXES DC X'0227' STX ESC 53820019 DC C'T' SELECT PRINTER AND TRIPLE SPACE 53880019 XMTORLNG DC H'412' LENGTH OF ORIGINAL READ BUFFER 000D 53940019 CNOP 0,4 54000019 SPACE 2 54060019 EXTRN IHKABXCN 000B 54120019 LRDABXCN DC A(IHKABXCN) BASE ADDRESS OF CONSTANT DSECT 54180019 SPACE 2 54240019 LRDRTREL EQU 4 RETURN TO LRDRELBF 54300019 LRDRTBWT EQU 8 RETURN FOR RJENDF WITH ERROR MESSAGE 54360019 LRDRTBRD EQU 12 RETURN FOR RJENDF LINE ERROR 54420019 LRDRTWJC EQU 16 RETURN TO LRDWRTJC 19018 54480019 LRDRTDLT EQU 20 RETURN TO LRDDELET 19018 54540019 LRDRTRLS EQU 24 RETURN TO IHKABLST AFTER WRIT 19018 54600019 XMTCOD12 EQU 28 RETURN CODE TO LRD 000D 54660019 LRDCHAR1 EQU C'1' TO INDICATE REMOTE MESSAGE 54720019 LRD1CRD EQU 80 TO INDICATE ONE CARD IN JCL BUFFER 54780019 LRDNOCRD EQU X'10' INDICATE NO CARDS IN JCL BUFFER 54840019 DEBUCBAD EQU 32 DISPLACEMENT FOR UCB ADDRESS IN DEB 54900019 LRDETX EQU X'03' ETX 54960019 LRDEOTCR EQU X'37' EOT 55020019 LRDBLANK EQU C' ' TO PUT BLANKS IN A FIELD 55080019 LRDINACT EQU X'40' TO MAKE FAST TABLE ENTRY INACTIVE 55140019 LRD7F EQU X'7F' GOOD COMPLETION CODE FOR I/O 55200019 LRDZERO EQU 0 55260019 LRDOFS4 EQU 4 UNDEFINED KEYWORD SYSIN 000C 55320019 LRDOFS6 EQU 6 INVALID TERMID 55380019 LRDOFS9 EQU 9 INVALID JOBNAME 55440019 LRDOFS16 EQU 16 INVALID KEYWORD PARAMETER DCB 000C 55500019 LRDOFS27 EQU 27 DUPLICATE JOBNAME 55560019 LRDOFS28 EQU 28 NO JOB CARD 55620019 LRDOFS29 EQU 29 MAX JOBS EXCEEDED 55680019 LRDOFS44 EQU 44 MISSING RJSTART 55740019 LRDOFS45 EQU 45 MISSING LOGON 55800019 LRDOFS54 EQU 54 OUT OF SPACE - SYSIN OR Q MANAGER 55860019 LRDOFS55 EQU 55 SYSIN LIMIT EXCEEDED 55920019 SIXTHEE EQU 63 DISPLACEMENT FACTOR 000D 55980019 LRDOFS66 EQU 66 I/O ERROR ON ASSIGN/START 56040019 LRDOFS67 EQU 67 I/O ERROR ON Q MGR NOT ASSIGN/START 56100019 LRDOFS68 EQU 68 I/O ERROR ON ALLOCATE 56160019 LRD8CHR EQU 8 8 MESSAGE PARAMETERS 56220019 LRD13CHR EQU 13 13 MESSAGE PARAMETERS 56280019 LRD14CHR EQU 14 14 MESSAGE PARAMETERS 56340019 LRD16CHR EQU 16 16 MESSAGE PARAMETERS 56400019 LRD17CHR EQU 17 17 MESSAGE PARAMETERS 56460019 LRD18CHR EQU 18 18 MESSAGE PARAMETERS 000C 56520019 LRD24CHR EQU 24 24 MESSAGE PARAMETERS 56580019 LRDQMCHN EQU 44 DISPLACEMENT OF JECL-JCL BUFFER 56640019 LRDCDIND EQU 168 DISPLACEMENT FOR CARD INDICATOR 56700019 LRDMSGBF EQU 373 DISPLACEMENT FOR MESSAGE IN BUFFER 56760019 XMTZERO EQU 0 DISPLACEMENT FACTOR 000D 56820019 XMTHREE EQU 3 DISPLACEMENT FACTOR 000D 56880019 LRDSYSIN EQU 39 SYSIN QUEUE NUMBER 19018 58909019 LRD2TTRS EQU X'20' TO ASSIGN TWO TTR'S 19018 58912019 LRDUSREX EQU 16 LINE ERROR USER EXIT DISPLACE 19018 58915019 LRDOFS13 EQU 13 LINE ERROR 19018 58918019 LRDCDNRC EQU 20 RETURN CODE FOR RJENDC OR RJE 19018 58921019 * NOT QUEUED 19018 58924019 LRDPOST EQU X'40' TO POST THE ECB'S OF IHKCCPLM 19018 58927019 LRDABCLS EQU 19 TO CHECK FOR RJENDF WITH ABNO 19018 58930019 LRDNOMSG EQU X'FF' FOR RJENDF WITH NO MESSAGE 19018 58933019 XMTMFTON EQU X'80' MASK TO TEST FOR CONTROL TYPE 19018 58936019 TDIRNQJM EQU X'CF' TURN OFF ENQUEUE JOBS AND ENQ 19018 58939019 * MESSAGES BITS 19018 58942019 TDIRRJLF EQU X'E7' TURN OFF RJSTART AND LOGON SW 19018 58945019 TDIRRJLG EQU X'18' TEST RJSTART AND LOGON SWITCH 19018 58948019 TDIRDARF EQU X'3E' TURN OFF DD DATA, DD *, NO RJ 19018 58951019 TDIRJDIP EQU X'FA' TURN OFF JED AND DISCONTINUED 19018 58954019 LCBNQBIT EQU X'80' INDICATE CARDS TO ENQUEUE 19018 58957019 LCBNQOFF EQU X'7F' INDICATE NO CARDS TO ENQUEUE 19018 58960019 LCBSTRJE EQU X'20' INDICATE RETURN OF ZERO TO LS 19018 58963019 LCBRJNDF EQU X'10' INDICATE RJENDF GENERATED 19018 58966019 EJECT 19018 58969019 LRDQMRES DSECT 19018 58972019 IEFQMRES QUEUE MANAGER RESIDENT AREA 19018 58975019 EJECT 19018 58978019 EJECT 59000018 IEFQMNGR QUEUE MANAGER PARAMETER AREA 59100018 QMPCA DS CL4 BUFFER ADDRESS OR TTR FROM ASSIGN 59200018 QMPEX DS CL4 TTR FOR WRITE 59300018 QMCHN DS CL4 TTR FOR NEXT WRITE 59400018 EJECT 59500018 IECTDECB 59600018 EJECT 59700018 DCBD DSORG=(BS,BX),DEVD=DA 59800018 EJECT 59900018 LRDUCBOB DSECT 60000018 IEFUCBOB 60100018 UCB2780 EQU X'03' INDICATES 2780 IN UCBTYP FIELD 60200018 EJECT 60300018 LRDCVT DSECT 60400018 CVT 60500018 EJECT 60600018 IHKDSECT TDIR 60700018 TDIRSYSF EQU X'3F' TURN OFF DD DATA AND DD * SWITCHES 60800018 TDIRSYSN EQU X'C0' TEST DD DATA AND DD * SWITCHES 60900018 EJECT 61000018 IHKDSECT ,,FASTAB 61100018 EJECT 61200018 IHKDSECT ,,,,LCB 61300018 LCBSWOFF EQU X'B0' TO TURN OFF LCB SWITCHES 61400018 LCBERRSW EQU X'40' INDICATE RETURN OF 8 TO IHKABLST 61500018 LCBLST28 EQU X'08' INDICATE RETURN OF 28 TO IHKABLST 61600018 LCBRET8 EQU X'02' INDICATE RETURN TO LRDRELBF 61700018 LCBABEND EQU X'01' INDICATE ABEND AFTER SENDING MESSAGE 61800018 EJECT 61900018 LRDCONST DSECT DSECT OF CONSTANTS IN IHKABLRD 62000018 * PARAMETER LIST FOR IHKCBLDM (BLDMSG) 62100018 LRDBLDM DS F HAS X'80000000' 000B 62200018 LRDBOFS DS H MESSAGE OFFSET 62300018 LRDBPMNO DS C NUMBER OF MESSAGE PARAMETER CHARS. 62400018 LRDBPARM DS CL24 MESSAGE PARAMETER CHARACTERS 62500018 CNOP 0,4 62600018 LRDSCAN DS H 000B 62700018 LRDSBLNK DS H 000B 62800018 LRDSADDR DS F 000B 62900018 LRDSSTOP DS F 000B 63000018 LRDSCHAR DS C 000B 63100018 DS 2C 000C 63200018 LRDENDDT DS CL3 000B 63300018 LRDDOTS DS CL3 000B 63400018 LRDRJNDF DS CL7 63500018 LRDRJSTT DS CL8 HAS 'RJSTART ' 63600018 LRDLOGON DS CL6 63700018 LRDCONT DS CL9 63800018 LRDJED DS CL4 000B 63900018 LRDLOGOF DS CL7 64000018 LRDRJEND DS CL6 64100018 LRDDOTRC DS CL3 64200018 LRDRJNDC DS CL7 64300018 LRDJOB DS CL4 000B 64400018 LRDDATA DS CL5 000B 64500018 LRDDD DS CL3 000B 64600018 LRDGNSYS DS CL8 HAS '//SYSIN ' 64700018 LRDCHAR DS C 64800018 LRDSPENT DS F TO TEST FOR SPECIAL ENTRY - IHKABRJF 64900018 LRDSLASH DS CL3 000B 65000018 LRDTASK DS CL8 HAS 'RJETASK ' 65100018 LRDHEADR DS CL9 HAS SOH HEADER FOR CPU ETB 65200018 LRDDLSTX DS CL2 HAS DLE STX 65300018 LRDSOHD DS CL2 65400018 LRDSOHR DS CL2 65500018 LRDCDJAM DS CL2 65600018 LRDCHARS DS H 000B 65700018 LRD3 DS H 65800018 LRD4 DS H 000B 65900018 LRD8 DS H 66000018 LRD18 DS H 66100018 LRD84 DS H 66200018 LRD200 DS H 66300018 LRDUCBAD DS F ADDRESS OF UCB ADDRESS 66400018 LRDDEC80 DS F 66500018 LRDSVBLK DS F 000B 66600018 LRDCCSCN DS F 000B 66700018 LRDAADSP DS F ENTRY POINT OF DISPATCHER 66800018 LRDCAINT DS F 66900018 LRDCBLDM DS F ENTRY POINT OF BUILD MESSAGE 67000018 LRDCDFMR DS F 67100018 LRDCDSCH DS F ENTRY POINT OF FAST TABLE SEARCH 67200018 LRDABALC DS F 000B 67300018 LRDABLST DS F 000B 67400018 LRDABXMT DS F 000B 67500018 LRDABLRD DS F 000B 67600018 LRDCDFLN DS F 000B 67700018 LRDCDSOC DS F 000B 67800018 LRDCDTDR DS F 000B 67900018 LRDZZAVT DS F 000B 68000018 IHKDSECT ,,,,,AVT 000B 68100018 END 68200018 ./ ADD SSI=01010200,NAME=IHKBBNIT,SOURCE=0 TITLE 'IHKBBNIT - NEL INTERFACE TASK ' 01000017 *********************************************************************** 02000017 * * 02800021 *A 785000 S21945 03600021 * * 04400021 * STATUS - CHANGE LEVEL 1, RELEASE 21 * 05200021 * * 06000021 *FUNCTION/OPERATION- 07000017 * THIS MODULE LINKS TO IEFVH1 (READER/INTERPRETER) AFTER HAVING BEEN 08000017 * ATTACHED BY IHKRJBGN. AT STOP RJE, IHKBBNIT CHECKS FOR AN ABNORMAL 09000017 * RETURN FROM R/I AND IF FOUND SETS BIT 5 IN RCS. REGARDLESS OF THE 10000017 * RETURN IT THEN POSTS THE ECB FOR THE RJE READER WITH A POST CODE OF 11000017 * ONE TO INDICATE THE R/I IS NO LONGER AVAILABLE. 12000017 * 13000017 *ENTRY POINT- 14000017 * IHKBBNIT IS THE ONLY ENTRY POINT. 15000017 * 16000017 *INPUT- 17000017 * STANDARD SUBROUTINE LINKAGE PREVAILS, REGISTER ONE CONTAINS A 18000017 * POINTER TO A THREE-WORD PARAMETER LIST. THE FIRST WORD POINTS TO 19000017 * THE RJE AUT, THE SECOND IS NOT USED, AND THE THIRD POINTS TO THE 20000017 * RJE READER'S ECB. 21000017 * 22000017 *OUTPUT- 23000017 * CLOSEDOWN INDICATION SET FOR IHKRJBGN AND READER. 24000017 *EXTERNAL ROUTINES- 25000017 * 26000017 * IEFVH1 - READER/INTERPRETER INITIALIZATION 27000017 * POST - POST RJE READER'S ECB 28000017 * 29000017 *EXITS-NORMAL- 30000017 * RETURN TO OPERATING SYSTEM 31000017 * 32000017 *EXITS-ERROR- 33000017 * N/A 34000017 * 35000017 *TABLES/WORK AREAS- 36000017 * AN 18 WORD SAVE AREA IS PROVIDED. 37000017 * 38000017 *ATTRIBUTES- 39000017 * SERIALLY REUSABLE 40000017 * 41000017 *NOTES- 42000017 * N/A 43000017 * 44000017 * 45000017 *********************************************************************** 46000017 SPACE 3 47000017 IHKBBNIT CSECT 48000017 R0 EQU 0 49000017 R1 EQU 1 50000017 R2 EQU 2 BASE REGISTER FOR AVT DSECT 51000017 R3 EQU 3 52000017 R4 EQU 4 ADDRESS OF RJE READER'S ECB 53000017 R5 EQU 5 ADDRESS OF COMMUNICATIONS SWITCHES 54000017 R6 EQU 6 55000017 R7 EQU 7 56000017 R8 EQU 8 57000017 R9 EQU 9 58000017 R10 EQU 10 59000017 R11 EQU 11 TEMPORARY WORK REGISTER 60000017 R12 EQU 12 BASE REGISTER 61000017 R13 EQU 13 SAVE AREA POINTER 62000017 R14 EQU 14 63000017 R15 EQU 15 RETURN CODE REGISTER 64000017 SAVE (14,12),,* SAVE CALLER'S REGISTERS 65000017 BALR R12,R0 ESTABLISH ADDRESSABILITY 66000017 USING *,R12 REGISTER 12 IS BASE REGISTER 67000017 LA R11,SAVE ADDRESS OF MY SAVE AREA 68000017 ST R11,8(R13) ESTABLISH BACK CHAIN 69000017 ST R13,SAVE+4 ADDRESS OF CALLER'S SAVE AREA 70000017 LR R13,R11 ADDRESS OF MY SAVE AREA 71000017 LM R2,R4,0(R1) R2 CONTAINS POINTER TO AVT 72000017 * R3 NOT USED 73000017 * R4 CONTAINS POINTER TO RJE RDR'S ECB 74000017 USING IHKZZAVT,R2 ADDRESSABILITY FOR RJE AVT DSECT 75000017 L R1,IHKZZNEL ADDRESS OF NEL FOR O/S R/I 76000017 LINK EP=IEFVH1 LINK TO O/S R/I 77000017 ST R1,IHKZZNEL UPDATE NEL POINTER FOR FREEMAIN 78000017 LA R4,0(0,R4) ZERO HIGH ORDER BYTE S21945 78500021 LTR R15,R15 CHECK RETURN CODE FROM R/I 79000017 BZ OK BRANCH IF THERE WAS NO I/O ERROR 80000017 L R5,IHKZZRCS ADDRESS OF COMMUNICATIONS SWITCHES 81000017 OI 0(R5),X'04' INDICATE ABNORMAL CENTRAL CLOSEDOWN 82000017 OK POST (4),1 POST RJE READER'S ECB FOR FINAL PASS 83000017 L R13,SAVE+4 ADDRESS OF CALLER'S SAVE AREA 84000017 RETURN (14,12),T,RC=0 RETURN CONTROL 85000017 SAVE DS 18F REGISTER SAVE AREA 86000017 IHKDSECT ,,,,,AVT 87000017 END 88000017 ./ ADD SSI=00012201,NAME=IHKBBRII,SOURCE=0 IHKBBRII CSECT 00500017 TITLE 'IHKBBRII - READER/INTERPRETER INTERFACE -MVT' 01000017 *********************************************************************** 01500017 *STATUS- 02000017 * CHANGE LEVEL 0 02500017 * 03000017 *FUNCTION/OPERATION- 03500017 * THIS MODULE IS A LOGICAL MEMBER OF THE ATTACHED R/I TASK BUT EXISTS 04000017 * PHYSICALLY IN THE RJE LOAD MODULE. THE ADDRESS OF IHKBBRII (RII) IS 04500017 * PASSED TO R/I BY IHKRJBGN WHEN THE R/I TASK IS ATTACHED. RII GAINS 05000017 * CONTROL WHEN R/I ISSUES A 'GET' FOR A RECORD. RII PROVIDES TWO 05500017 * SERVICES TO THE MAIN RJE TASK- (1) AN INTERFACE BETWEEN THE RJE 06000017 * READER AND THE READER/INTERPRETER, AND (2) LOADS AND DELETES NON- 06500017 * RESIDENT MODULES FOR THE RJE READER AND COMMAND INTERPRETER. 07000017 * 07500017 * WHEN RII GETS CONTROL, IT POSTS THE ECB FOR THE RJE READER TO 08000017 * INDICATE THAT THE R/I HAS ISSUED A 'GET' FOR A RECORD. IT THEN 08500017 * WAITS ON AN ECB LIST (CURRENTLY ECBS FOR RJE READER AND FOR COMMAND 09000017 * INTERPRETER). 09500017 * 10000017 * WHEN ONE OF THE ECBS IS POSTED RII DETERMINES WHO POSTED HIM, TURNS 10500017 * OFF THE POST BIT, DETERMINES WHICH ECB TO POST WHEN THIS REQUEST IS 11000017 * SATISFIED, AND INITIALIZES FOR A LOAD OR DELETE. RII THEN 11500017 * DETERMINES THE TYPE OF REQUEST AND PERFORMS ONE OF THE FOLLOWING- 12000017 * 1. RECORD TO R/I - THE ADDRESS OF THE RECORD IS PLACED IN THE 12500017 * R/I SAVE AREA AND CONTROL IS RETURNED TO R/I. 13000017 * 2. LOAD - MODULE IS LOADED, ECB OF REQUESTOR IS POSTED (POST 13500017 * CODE IS ENTRY POINT OF MODULE), AND A WAIT IS ISSUED FOR 14000017 * NEXT REQUEST. 14500017 * 3. DELETE - MODULE IS DELETED, ECB OF REQUESTOR IS POSTED, AND 15000017 * A WAIT IS ISSUED FOR NEXT REQUEST. 15500017 * 4. EODAD - EODAD ADDRESS IS MOVED INTO R/I SAVE AREA AND 16000017 * CONTROL IS RETURNED TO R/I. 16500017 * 17000017 *ENTRY POINT- 17500017 * IHKBBRII IS THE ONLY ENTRY POINT. THE CALLING SEQUENCE FOR 18000017 * RJE MODULES IS- 18500017 * LA 0,PARM 19000017 * LA 1,RIECB 19500017 * POST (1),(0) 20000017 *WHERE PARM IS A FULL WORD. THE HIGH ORDER BYTE IS THE OPERATION CODE- 20500017 * X'00' - RECORD FOR R/I 21000017 * X'04' - LOAD 21500017 * X'08' - DELETE 22000017 * X'0C' - EODAD 22500017 * THE LOW ORDER THREE BYTES ARE USED IN THE FOLLOWING MANNER- 23000017 * OP. CODE LOW ORDER BYTES 23500017 * 0 ADDRESS OF RECORD 24000017 * 4 SECOND BYTE IS LAST CHARACTER OF NAME FOR SHOWS 24500017 * (OTHERWISE NOT USED), THE TWO LOW ORDER BYTES ARE 25000017 * THE OFFSET TO THE MODULE NAME. 25500017 * 8 SAME AS FOR LOAD 26000017 * 12 NOT USED 26500017 * 27000017 *INPUT- 27500017 * AS DESCRIBED ABOVE. 28000017 * 28500017 *OUTPUT- 29000017 * THE REQUESTED FUNCTION IS PERFORMED AND THE REQUESTOR IS POSTED. 29500017 * FOR A LOAD REQUEST, THE POST CODE IS THE ADDRESS OF THE ENTRY POINT 30000017 * OF THE LOADED ROUTINE, FOR EODAD, THE READER IS POSTED BY IHKBBNIT 30500017 * WITH A CODE OF 1, AND FOR THE OTHER REQUESTS THE POST CODE IS ZERO. 31000017 * 31500017 *EXTERNAL ROUTINES- 32000017 * WAIT - WAIT ON ECBLIST. 32500017 * POST - INFORM REQUESTOR OF COMPLETION OF REQUEST. 33000017 * LOAD - LOAD NON-RESIDENT MODULE 33500017 * DELETE- DELETE NON-RESIDENT MODULE 34000017 * 34500017 *EXITS-NORMAL- 35000017 * IHKBBRII RETURNS TO R/I. 35500017 * 36000017 *EXITS-ERROR- 36500017 * N/A 37000017 * 37500017 *TABLES/WORK AREAS- 38000017 * AN 84 BYTE TABLE OF MODULE NAMES, AN 8 BYTE ECB LIST, AND 16 BYTES 38500017 * OF ASSOCIATED ECBS ARE MAINTAINED. 39000017 * 39500017 *ATTRIBUTES- 40000017 * SERIALLY REUSABLE. 40500017 * 41000017 *NOTES- 41500017 * N/A 42000017 * 42500017 *********************************************************************** 43000017 EJECT 43500017 R0 EQU 0 44000017 R1 EQU 1 PARAMETER REGISTER 44500017 R2 EQU 2 WORK REGISTER 45000017 R3 EQU 3 45500017 R4 EQU 4 46000017 R5 EQU 5 46500017 R6 EQU 6 47000017 R7 EQU 7 47500017 R8 EQU 8 48000017 R9 EQU 9 48500017 R10 EQU 10 49000017 R11 EQU 11 TEMPORARY WORK REGISTER 49500017 R12 EQU 12 BASE REGISTER 50000017 R13 EQU 13 SAVE AREA POINTER 50500017 R14 EQU 14 51000017 R15 EQU 15 51500017 SAVE (14,12),,* SAVE READER/INTERPRETER'S REGISTERS 52000017 BALR R12,R0 ESTABLISH ADDRESSABILITY 52500017 USING *,R12 REGISTER 12 IS BASE REGISTER 53000017 LA R11,SAVE ADDRESS OF MY SAVE AREA 53500017 ST R11,8(R13) ESTABLISH BACK CHAIN 54000017 ST R13,SAVE+4 ADDRESS OF CALLER'S SAVE AREA 54500017 LR R2,R1 SAVE POINTER TO DCB USED BY R/I 55000017 SR R3,R3 CLEAR INDEX REGISTER 55500017 LR R0,R3 CLEAR REGISTER ZERO 56000017 LA R6,ECBLIST 56500017 LA R7,IHKCBRDP ADDRESS OF RJE READER'S ECB 57000017 POST LR R1,R7 57500017 POST (1),(0) POST RJE READER'S ECB 58000017 LR R1,R6 ADDRESS OF ECB LIST 58500017 WAIT ECBLIST=(1) 59000017 LR R1,R6 59500017 AGAIN L R4,0(R1) GET POINTER TO ECB 60000017 TM 0(R4),POSTR IS ECB POSTED 60500017 BO PROS YES, PROCESS REQUEST 61000017 LA R1,4(R1) NO, INCREMENT TO NEXT ECB 61500017 B AGAIN CHECK ECB 62000017 PROS NI 0(R4),ZERO CLEAR POST BIT 62500017 L R5,0(R4) CONTENTS OF ECB IN R5 63000017 LA R7,0(R4) SAVE ECB ADDRESS 63500017 S R7,0(R6) GET OFFSET FOR ECB TO BE POSTED 64000017 LA R7,IHKCAINP(R7) GET ADDRESS OF ECB TO BE POSTED 64500017 DOIT LA R1,ROUTNAME TABLE OF ROUTINE NAMES 65000017 AH R1,2(R5) GET POINTER TO ROUTINE NAME 65500017 MVC NAME(4),0(R1) MOVE NAME INTO PARM LIST 66000017 CLI 3(R5),SHOW IS THIS A SHOW REQUEST 66500017 BNE INSERT NO 67000017 MVC NAME+3(1),1(R5) YES INSERT LAST CHARACTER OF NAME 67500017 INSERT IC R3,0(R5) INSERT OPERATION CODE 68000017 B *+4(R3) BRANCH TABLE TO OPERATION 68500017 B PROCREC GIVE R/I RECORD 69000017 B LOADR LOAD NON-RESIDENT ROUTINE 69500017 B DELETER DELETE NON-RESIDENT ROUTINE 70000017 EODAD MVC 13(3,R13),33(R2) EODAD ADDRESS FROM DCB 70500017 RETURN RETURN (14,12),T,RC=0 RETURN CONTROL TO R/I 71000017 PROCREC L R5,0(R5) 71500017 ST R5,24(R13) PUT POINTER IN R/I SAVEAREA 72000017 B RETURN GO SET UP FOR NORMAL RETURN TO R/I 72500017 LOADR LOAD EPLOC=REPLOC 73000017 B POST RETURN CONTROL TO RJE 73500017 DELETER DELETE EPLOC=REPLOC 74000017 SR R0,R0 74500017 B POST RETURN CONTROL TO RJE 75000017 SAVE DC 3F'0' REGISTER SAVE AREA 75500017 ECBLIST DC A(IHKCAINE) ECB LIST 76000017 DC X'80' 76500017 DC AL3(IHKCBRDE) 77000017 IHKCAINE DC F'0' ECB INDICATING IHKCXINT REQUEST 77500017 IHKCBRDE DC F'0' ECB INDICATING IHKCXRDR REQUEST 78000017 IHKCAINP DC F'0' ECB SHOWING IHKCXINT REQUEST DONE 78500017 IHKCBRDP DC F'0' ECB SHOWING READER REQUEST DONE 79000017 POSTR EQU X'40' 79500017 ZERO EQU 0 80000017 SHOW EQU X'30' SHOW ROUTINES OFFSET 80500017 REPLOC DC C'IHKC' 81000017 NAME DC CL4' ' 81500017 SPACE 3 82000017 ROUTNAME DC F'0' 82500017 DC C'BLGN' 000A 83000017 DC C'BRJS' 000A 83500017 DC C'GDLT' 000A 84000017 DC C'BLGF' 000A 84500017 DC C'FBDR' 000A 85000017 DC C'FOUT' 000A 85500017 DC C'FSTA' 000A 86000017 DC C'ARJN' 000A 86500017 DC C'HCNT' CENOUT 000B 87000017 DC C'DBDC' BRDCST 87500017 DC C'BUID' USERID 88000017 DC C'ASHO' SHOW 88500017 DC C'FMSG' 000A 89000017 DC C'FMSG' 000A 89500017 DC C'GALT' 000A 90000017 DC C'BRJS' 000A 90500017 DC C'ARJN' 000A 91000017 DC C'ARJN' 000A 91500017 DC C'HJPR' 92000017 DC C'FSTB' 92500017 ENTRY IHKCAINE,IHKCBRDE,IHKCAINP,IHKCBRDP 93000017 END 93500017 ./ ADD SSI=02012901,NAME=IHKCAINT,SOURCE=0 INT3 TITLE 'COMMAND INTERPRETER WITH A,M,L' 00050017 *3470011000-011500,276500-280000,282500-285000 000A 00100017 *1090044500,046000,070000,173500,267500,269000,272000,285000, 000B 00150017 *1090363000,5510000-553500,744000-744500 000B 00200017 *1090266500,741000-742000 000B 00250017 *2515285000-287000 000C 00270018 *250000-251000,884000 A32850 00280020 * 077000 00290020 *********************************************************************** 00300017 *FUNCTION/OPERATION: 00350017 * GIVEN AN EIGHTY COLUMN CARD IMAGE OF A COMMAND,THIS ROUTINE 00400017 * SCANS THE OPERAND. IF A SYNTAX ERROR IS FOUND A MESSAGE IS SENT. IF 00450017 * NO ERRORS ARE FOUND, THE OPERAND IS CONDENSED TO A FIXED 15-BYTE 00500017 * FIELD AND THE COMMAND PROCESSOR IS GIVEN CONTROL. 00550017 * EXCEPTIONS TO NORMAL PROCEDURE 00600017 * 1.CONTINUE-THERE IS NO COMMAND PROCESSOR.THE COMMAND INTERPRETEP 00650017 * SETS BITS 9 AND 10 IN TDIRSWCH TO INDICATE OPERAND(BIT CONFIGURA- 00700017 * TIONS ARE 01-BEGIN,10-NO,11-NO OPERAND). 00750017 * 2.RJSTART AND LOGON-AFTER THE COMMAND IS PROCESSED,IF CONTROL CAME 00800017 * FROM THE C/E,THE ADDRESS IN REGISTER 1 WILL BE RETURNED IN THE 00850017 * THIRD WORD OF ITS PARAMETER LIST. IF THE COMMAND WAS VALID, THIS 00900017 * IS THE ADDRESS OF THE TDIR ENTRY,IF INVALID,THE ADDRESS OF THE 00950017 * ERROR MESSAGE. 01000017 * 01050017 *ENTRY POINTS: 01100017 * IHKCAINT 01150017 * 01200017 * REGISTER 1 CONTAINS THE ADDRESS OF THE FOLLOWING PARAMETER LIST: 01250017 * 1.THE FIRST BYTE CONTAINS THE COMMAND OFFSET WHICH IS USED TO 01300017 * LOCATE THE PROPER INTERPRETING AND PROCESSING ROUTINES. 01350017 * 0-UNDEFINED OPERATION 01400017 * 4-LOGON 01450017 * 8-RJSTART 000A 01500017 * 12-DELETE 000A 01550017 * 16-LOGOFF 000A 01600017 * 20-BRDCSTR 01650017 * 24-OUTPUT 01700017 * 28-STATUS 01750017 * 32-RJEND 01800017 * 36-CENOUT 01850017 * 40-BRDCST 01900017 * 44-USERID 01950017 * 48-SHOW 02000017 * 52-MSG 02050017 * 56-MSGR 02100017 * 60-ALERT 02150017 * 64-CONTINUE 02200017 * 68-RJENDF 02250017 * 72-RJENDC 02300017 * 2.THE NEXT THREE BYTES CONTAIN THE ADDRESS OF THE FIRST CHARACTER 02350017 * OF THE COMMAND. 02400017 * 3.THE SECOND FULLWORD CONTAINS THE ADDRESS OF THE BEGINNING 02450017 * POSITION OF THE CARD IMAGE. 02500017 * 4.THE THIRD WORD CONTAINS THE ADDRESS OF TERMINAL DIRECTORY ENTRY. 02550017 * 02600017 * IHKCACOM 02650017 * 02700017 * THIS IS THE LOCATION OF A LIST OF THE FOLLOWING ADDRESSES 02750017 * 02800017 * 1.TDIR ENTRY 02850017 * 2.95-BYTE CARD IMAGE 02900017 * 3.IHKAADSP 02950017 * 4.IHKCCSCN 03000017 * 5.IHKCDTMR 03050017 * 6.IHKCBLDM 03100017 * 7.IHKCDSCH 03150017 * 8.IHKCCSGN 03200017 * 9.IHKCCPLM 03250017 * 10.IHKCDLLN 03300017 * 11.IHKCBSTD 03350017 * 12.IHKCCSUD 03400017 * 13.IHKCDLNB 03450017 * 14.IHKCDUMR 03500017 * 15.IHKCDLNT 03550017 * 16.IHKCDUDR 03600017 * 17.IHKCDULN 03650017 * 18.IHKCDUNB 03700017 * 19.IHKCDFTB 03750017 * 20.IHKCDFLN 03800017 * 21.IHKCDFNB 03850017 * 22.IHKCDTDR 03900017 * 23.IHKCDTLN 03950017 * 24.IHKCDTNB 04000017 * 25.IECTLERP 04050017 * 26.IHKCDCBS 04100017 * 27.IHKCDFMR 04150017 * 28.IHKCDJMR 04200017 * 29.IHKCDSOC 04250017 * 30.IHKCDFES 04300017 * 31.IHKCDCMR 04350017 * 32.IHKCDOMR 04400017 * 33.IHKCDJLN 04450017 * 34.CSCB 04500017 * 35.IHKAALST+8 04550017 * 36.IHKCHRDR 000B 04600017 * 37.IHKCEDIT 04650017 * 38.NEL 04700017 * 39.IHKCHASE 000B 04750017 * 40.IHKCBSAE 04800017 * 41.IHKCDRCS 04850017 * 42.IHKCCQMG 04900017 * 43.IHKBBCCR 000A 04950017 * 44.IHKRJBGN 000A 05000017 * 44.5 IHKCHSDQ 000B 05050017 * 45.C/E PARAMETER LIST 000A 05100017 * 46.IHKABLWT 000A 05150017 * 47.IHKABLST 000A 05200017 * 48.IHKCCECB 000A 05250017 * 49. IHKCCBUF 000A 05300017 * 50. IEFQMSSS 000B 05350017 * 51. IEFQDELE 000B 05400017 * 52. IEFQMDQ2 000B 05450017 * 53. IEFSD447 000B 05500017 * 54. RDR QMGR ECB ADDR 000B 05550017 * 55. SYSDQ QMGR ECB ADDR 000B 05600017 * 56. MESSAGE LOCATIONS 05610020 * 57. RESIDENT MESSAGES 05620020 *INPUT-N/A 05650017 * 05700017 *OUTPUT-N/A 05750017 * 05800017 *EXTERNAL ROUTINES: 05850017 * IHKCAMSN-SCAN MESSAGE TEXTS AND RESOLVE DOUBLE QUOTES 05900017 * 05950017 * REGISTER 1 CONTAINS THE ADDRESS OF THE FOLLOWING PARAMETER LIST 06000017 * 06050017 * 1.THE FIRST WORD CONTAINS THE ADDRESS OF THE LEADING QUOTE. 06100017 * 2.THE SECOND WORD CONTAINS THE STOPPING ADDRESS (END OF CARD). 06150017 * 3.THE THIRD WORD CONTAINS THE MAXIMUM ALLOWABLE MESSAGE LENGTH. 06200017 * 06250017 * IHKCCSCN-SCAN OPERAND FOR BLANK,NON-BLANK,COMMA OR QUOTE 06300017 * REGISTER 1 CONTAINS THE ADDRESS OF THE FOLLOWING PARAMETER LIST 06350017 * 06400017 * 1.THE FIRST HALFWORD CONTAINS THE MAXIMUM SCAN LENGTH. 06450017 * 2.THE SECOND HALFWORD CONTAINS THE NUMBER OF SENSITIVE CHARACTERS. 06500017 * 3.THE SECOND WORD CONTAINS THE STARTING ADDRESS. 06550017 * 4.THE THIRD WORD CONTAINS THE STOPPING ADDRESS. 06600017 * 5.THE FOLLOWING BYTES CONTAIN THE STRING OF SENSITIVE CHARACTERS. 06650017 * IHKCBLDM-BUILDMSG 06700017 * REGISTER 1 CONTAINS THE ADDRESS OF THE FOLLOWING PARAMETER LIST 06750017 * 06800017 * 1.THE FIRST WORD CONTAINS ADDRESS OF THE TERMINAL DIRECTORY ENTRY. 06850017 * 2.THE NEXT HALFWORD CONTAINS THE MESSAGE OFFSET. 06900017 * 3.THE NEXT BYTE CONTAINS THE LENGTH INDICATOR. 06950017 * 4.THE NEXT EIGHT BYTES CONTAIN THE COMMAND NAME. 07000017 * 5.THE NEXT EIGHT BYTES CONTAIN THE SEQUENCE NUMBER. 07050017 * 07100017 * IHKCBLGN-LOGON 07150017 * IHKCBRJS-RJSTART 07200017 * IHKCGDLT-DELETE 07250017 * IHKCBLFG-LOGOFF 07300017 * IHKCFBDR-BRDCSTR 07350017 * IHKCFOUT-OUTPUT 07400017 * IHKCFSTA-STATUS 07450017 * IHKCARJN-RJEND 07500017 * IHKCHCNT-CENOUT 000B 07550017 * IHKCDBDC-BRDCST 07600017 * IHKCBUID-USERID 07650017 * IHKCASHL-SHOW LERB 07660020 * IHKCASHM-SHOW MSGS 07670020 * IHKCASHB-SHOW BRDCST 07680020 * IHKCHATS-SHOW TERMS AND ACTIVE 07690020 * IHKCHJIR-SHOW JOBS 07700020 * IHKCHSUP-SHOW USERS 07710020 * IHKCFMSG-MSG AND MSGR 07750017 * IHKCGALT-ALERT 07800017 * 07850017 * REGISTER 1 CONTAINS THE ADDRESS OF IHKCACOM. THE HIGH ORDER BIT 07900017 * INDICATES WHICH ROUTINE CALLED THE COMMAND INTERPRETER (0-C/E,1- 07950017 * READER). 08000017 * 08050017 *EXITS-NORMAL: 08100017 * REGISTER 15 CONTAINS ZERO. 08150017 *EXITS-ERROR: 08200017 * REGISTER 15 CONTAINS FOUR IF AN ERROR WAS FOUND BY EITHER THE 08250017 * INTERPRETER OR THE PROCESSOR. 08300017 * 08350017 *ATTRIBUTES 08400017 * 08450017 * SERALLY REUSABLE 08500017 * 08550017 *NOTES 08600017 * 08650017 * THE OPERATION OF THIS ROUTINE DEPENDS UPON AN INTERNAL REPRESENTA- 08700017 * TION OF THE EXTERNAL CHARACTER SET WHICH IS EQUIVALENT TO THE ONE 08750017 * USED AT ASSEMBLY TIME. THE CODING HAS BEEN ARRANGED SO THAT REDEFI- 08800017 * NITION OF 'CHARACTER'CONSTANTS,BY REASSEMBLY,WILL RESULT IN A 08850017 * CORRECT ROUTINE FOR THE NEW DEFINITIONS. 08900017 * 08950017 * IF THERE IS ANY CHANGE IN THE SYNTAX OF THE JECL STATEMENTS,SUCH AS 09000017 * CHANGED KEYWORDS OR VARIED FIELD LENGTHS,REDEFINITION OF THE PROPER 09050017 * CONSTANTS WILL RESULT IN A CORRECT ROUTINE FOR THE NEW JECL SYNTAX. 09100017 * 09150017 *********************************************************************** 09200017 SPACE 3 09250017 IHKCAINT CSECT 09300017 R0 EQU 0 09350017 R1 EQU 1 ADDRESS OF PARAMETER LISTS 09400017 R2 EQU 2 ADDRESS OF COMMAND 09450017 R3 EQU 3 ADDRESS OF CARD IMAGE 09500017 R4 EQU 4 ADDRESS OF TERMINAL DRCTY ENTRY 09550017 R5 EQU 5 COMMAND CODE USED FOR BRANCHING 09600017 R6 EQU 6 WORK REG 09650017 R7 EQU 7 WORK REG 09700017 R8 EQU 8 WORK REG 09750017 R9 EQU 9 BRANCH REG 09800017 R10 EQU 10 WORK REG 09850017 R11 EQU 11 BRANCH REG 09900017 R12 EQU 12 BASE REG 09950017 R13 EQU 13 SAVE AREA 10000017 R14 EQU 14 RETURN REG 10050017 R15 EQU 15 ENTRY REG 10100017 SPACE 10150017 USING TDIREC,R4 10200017 USING CMDWORK,R5 10250017 SPACE 3 10300017 USING IHKCAINT,R15 10350017 B 12(0,R15) 10400017 DC CL8'IHKCAINT' 10450017 CMDINT STM R14,R12,12(R13) SAVE REGS 10500017 LA R5,CMDPASS2 ADDRESS OF WORK AREA 10550017 B CMDINT0 10600017 USING IHKCAVER,R15 10650017 ENTRY IHKCAVER 10700017 IHKCAVER STM R14,R12,12(R13) 10750017 LA R5,CMDPASS1 ADDRESS OF WORK AREA 10800017 CMDINT0 EQU * 10850017 BALR R12,0 10900017 USING *,R12 10950017 SR R14,R14 11000017 L R15,CMDAADSP 11050017 TS CMDBUSY CHECK BUSY FLAG AND SET IT 11100017 BCR 7,R15 GO TO DISPATCH IF ROUTINE BUSY 11150017 ST R13,CMDSAVE+4 11200017 LA R11,CMDSAVE 11250017 ST R11,8(R13) 11300017 LR R13,R11 11350017 SPACE 11400017 *END OF STANDARD LINKAGE 11450017 SPACE 3 11500017 SR R8,R8 CLEAR 11550017 IC R8,0(R1) GER COMMAND VERB CODE 11600017 LM R2,R4,0(R1) LOAD OTHER PARAMETERS 11650017 LA R6,70(R3) 11700017 ST R6,CMDSCLST+8 STOPPING ADDRESS 11750017 MVI CMDINFO,C' ' BLANK 11800017 MVC CMDINFO+1(24),CMDINFO INITIALIZE TO BLANKS 11850017 MVC CMDERPRM,CMDINFO BLANK OUT PARAMETER FIELD 11900017 ST R1,CMDSW SAVE CALLING ROUTINE INDICATOR 11950017 XC CMDSW+1(3),CMDSW+1 ZERO OUT AREA 12000017 SPACE 3 12050017 *SCAN OPERATION FIELD 12100017 SPACE 12150017 LA R1,0(R2) CLEAR OUT VERB CODE 000A 12200017 LA R9,CMDINT4M SET UP RETURN ADDRESS 000B 12250017 BAL R2,CMDINT40 SCAN FOR BLANK 12300017 CMDINT4M DS 0H 000B 12350017 SR R1,R6 GET LENGTH 12400017 EX R1,CMDINST5 MOVE COMMAND TO BUILDMSG PARM 12450017 LR R1,R10 POSITION OF BLANK 12500017 SPACE 12550017 MVI CMDERSW,0 INITIALIZE ERROR INDICATOR 12600017 CLI 71(R3),C' ' CHECK FOR CONTINUATION PUNCH 12650017 BE CMDINT2 12700017 BAL R9,CMDERR10 ERROR CONDITION-CONTINUATION-72 12750017 CMDINT2 LA R9,CMDINT7 SET RETURN REG 12800017 STC R8,CMDCODE+1 SAVE CODE 12850017 ST R4,CMDPARM ADDRESS OF TDIR ENTRY 12900017 B CMDINT6(R8) GO TO BRANCHING TABLE 12950017 SPACE 13000017 *BRANCHING TABLE TO TAKE CONTROL TO PROPER COMMAND INTERPRETATION ROUTN 13050017 SPACE 13100017 CMDINT6 B CMDERR0 ERROR CONDETION-UNDEFINED OPERT 13150017 B CMDL LOGON 13200017 B CMDR RJSTART 13250017 B CMDD DELETE 13300017 B CMDF LOGOFF 13350017 B CMDB BRDCST(REMOTE) 13400017 B CMDO OUTPUT 13450017 B CMDS STATUS 13500017 B CMDJ RJEND 13550017 B CMDC CENOUT 13600017 B CMDT BRDCST(CENTRAL) 13650017 B CMDU USERID 13700017 B CMDH SHOW 13750017 B CMDG MSG(CENTRAL) 13800017 B CMDM MSG(REMOTE) 13850017 B CMDA ALERT 13900017 B CMDN CONTINUE 13950017 B CMDX RJENDF 14000017 B CMDY RJENDC 14050017 SPACE 3 14100017 *POINT OF RETURN,INDICATING NO OPERAND WAS FOUND 14150017 SPACE 3 14200017 CMDINT4 MVI CMDINFO+1,0 14250017 SPACE 14300017 *POINT OF RETURN,AFTER EXTENDED RECORD HAS BEEN BUILT 14350017 SPACE 14400017 CMDINT7 CLI CMDERSW,0 CHECK FOR SYNTAX ERRORS 14450017 BNE CMDINT8 DO NOT PROCESS COMMAND 14500017 CLI CMDSW,0 CHECK FOR ENTRY FROM READER 14550017 BNE CMDINT8 BRANCH IF FROM THE C/E 14600017 CMDINT3 MVC CMDCARD(80),0(R3) MOVE CARD IMAGE TO WORK AREA 14650017 LA R1,CMDPARM ADDRESS OF PARAMETER LIST 14700017 LH R8,CMDCODE GET VERB CODE 14750017 L R15,CMDRTNS(R8) GET ADDRESS OF PROCESSING RTN 14800017 ST R15,CMDNAME NAME OF ROUTINE FOR LOAD 14850017 SPACE 14900017 CLI CMDNAME,0 CHECK FOR RESIDENT ROUTINE 14950017 BNE CMDINT75 BRANCH IF NON-RESIDENT 15000017 BALR R14,R15 PROCESS COMMAND 15050017 B CMDINT9 15100017 SPACE 15150017 CMDINT75 EQU * 15200017 LOAD EPLOC=CMDEPLOC LOAD COMMAND PROCESSING RTN 15250017 LR R15,R0 LOAD ENTRY POINT 15300017 LA R1,CMDPARM ADDRESS OF PARAMETER LIST 15350017 BALR R14,R15 PROCESS COMMAND 15400017 DELETE EPLOC=CMDEPLOC DELETE PROCESSING ROUTINE 15450017 B CMDINT9 15500017 CMDINT8 SR R15,R15 15550017 IC R15,CMDERSW RETURN CODE 15600017 CMDINT9 L R13,CMDSAVE+4 15650017 NI CMDBUSY,0 TURN OFF BUSY FLAG 15700017 CLI CMDSW,0 CHECK CALLING ROUTINE 15750017 BE CMDINT10 BRANCH IF READER 15800017 L R2,24(R13) GET ADDRESS OF C/E'S LIST 15850017 ST R1,8(R2) RETURNADDRESS OF MSG OR TDIR 15900017 CMDINT10 RETURN (14,12),T,RC=(15) 15950017 SPACE 3 16000017 *********************************************************************** 16050017 SPACE 16100017 *THE FOLLOWING SEQUENCES OF INSTRUCTIONS ARE USED SEVERAL TIMES THROUGH 16150017 *OUT THE ROUTINE WITH A BAL R11 INSTRUCTION 16200017 SPACE 3 16250017 *CALL SCAN ROUTINT TO LOOK FOR 1ST NON-BLANK 16300017 SPACE 16350017 CMDINT20 XC CMDSCLST(4),CMDSCLST SET TO SCAN FOR NON-BLANK 16400017 CMDINT22 ST R1,CMDSCLST+4 STARTING ADDRESS 16450017 LR R6,R1 SAVE START POSITION 16500017 LA R1,CMDSCLST 16550017 L R15,CMDSCAN ADDRESS OF SCAN ROUTINE 16600017 BALR R14,R15 CALL SCAN 16650017 LR R10,R1 SAVE COMMA OR BLANK POSITION 16700017 B 0(R11,R15) CHECK RETURN CODE-RETURN TO X16750017 CALLING ROUTINE(ADDRESS IN R11) 16800017 SPACE 3 16850017 *CALL SCAN ROUTINE TO LOOK FOR A BLANK OR A COMMA 16900017 SPACE 16950017 CMDINT24 MVI CMDSCLST+3,2 SET TO SCAN FOR BLANK OR COMMA 17000017 MVC CMDSCLST+12(2),CMDBLCOM 000A 17050017 B CMDINT22 17100017 SPACE 3 17150017 *GET LENGTH OF OPERAND AND CHECK FOR LENGTH OF ZERO 17200017 SPACE 17250017 CMDINT30 SR R1,R6 GER LENGTH OF OPERAND 17300017 BZ CMDERR5 ERROR CONDITION-LENGTH OF ZERO 17350017 BR R11 RETURN 17400017 SPACE 3 17450017 *CHECK FOR END OF OPERAND 17500017 SPACE 17550017 CMDINT35 LA R9,CMDINT7 RESTORE RETURN REG 17600017 B *(R15) CHECK SCANS RETURN CODE 17650017 B CMDINT7 END OF OPERAND 17700017 B CMDERR5 ERROR CONDITION-ILLEGAL COMMA 17750017 SPACE 3 17800017 *SCAN FOR BLANK OR COMMA AND CHECK SCAN RETURN CODE 17850017 SPACE 17900017 CMDINT40 BAL R11,CMDINT24 SCAN FOR BLANK OR COMMA 17950017 B CMDINT4N NO DELIMITER FOUND 000B 18000017 B 0(R2) RETURN 18050017 BR R2 RETURN 18100017 SPACE 3 18150017 CMDINT4N DS 0H 000B 18200017 CMDINT42 EQU * 18250017 LA R1,71(R3) ADDRESS OF CARD COL, 72 18300017 CLI 0(R1),C' ' CHECK FOR BLANK IN 72 18350017 BCR 8,R2 BRANCH IF BLANK FOUND 18400017 BR R9 STOP SCAN IF BLANK NOT FOUND 18450017 *CHECK MSG TEXT FIELD AND CHECK RETURN PARAMETERS FROM MSG SCAN. 18500017 SPACE 18550017 CMDINT50 EQU * 18600017 ST R1,CMDMSLST QUOTE ADDRESS 18650017 MVC CMDMSLST+5(3),CMDSCLST+9 STOPPING POSITION FOR SCAN 18700017 MVI CMDMSLST+11,40 MAX MSG LENGTH OF 40 000A 18750017 LA R1,CMDMSLST 18800017 L R15,CMDMSN 18850017 BALR R14,R15 CALL MSG SCAN 18900017 SPACE 3 18950017 B *+4(R15) CHECK RETURN CODE 19000017 B CMDINT52 NO ERRORS 19050017 B CMDERR11 ERROR CONDITION-IMBEDDED QUOTE 19100017 B CMDERR11 ERROR CONDITION-NO RIGHT QUOTE 19150017 B CMDERR7 ERROR CONDITION 19200017 SPACE 3 19250017 CMDINT52 EQU * 19300017 LM R6,R8,0(R1) GET RETURN PARAMETERS 19350017 SR R6,R3 19400017 SR R7,R3 19450017 BR R11 RETURN 19500017 SPACE 3 19550017 *CHECK FOR TEXT LENGTH OF ZERO. 19600017 SPACE 19650017 CMDINT60 EQU * 19700017 SR R7,R6 LENGTH OF TEXT 19750017 CH R7,CMDHALF1 CHECK FOR NO TEXT 000A 19800017 BCR 2,R11 BRANCH IF NOT ZERO LENGTH 19850017 LR R1,R11 SAVE RETURN REG 19900017 BAL R9,CMDERR7 ERROR CONDITION-NO TEXT 19950017 LA R9,CMDINT7 20000017 BR R11 RETURN 20050017 SPACE 3 20100017 *********************************************************************** 20150017 SPACE 3 20200017 *ERROR ROUTINE 20250017 SPACE 3 20300017 *PUT ERROR MESSAGE OFFSETS INTO PARAMETER LIST FOR BUILDMSG 20350017 SPACE 20400017 SPACE 3 20450017 SPACE 20500017 DROP R4 20550017 USING TDIREC,R1 20600017 SPACE 20650017 CMDERR19 EQU * 20700017 MVI CMDOFSET,50 LOGON REJECTED 20750017 MVI CMDERLN,21 LENGTH OF PARAMETERS 20800017 MVI CMDERPRM+L'TDIRUSID,C' ' 20850017 MVC CMDERPRM(L'TDIRUSID),TDIRUSID 20900017 MVC CMDERPRM+L'UDIRUSID+1(L'TDIRTERM),TDIRTERM 20950017 MVC CMDERPRM+L'UDIRUSID+1+L'TDIRTERM(9),71(R3) 21000017 B CMDERR23 21050017 SPACE 21100017 DROP R1 21150017 USING TDIREC,R4 21200017 SPACE 3 21250017 CMDERR0 MVI CMDERLST+5,20 INVALID OPERATION 21300017 B CMDERR20 21350017 SPACE 3 21400017 CMDERR1 MVI CMDERLST+5,25 INVALID LINENAME 21450017 B CMDERR20 21500017 SPACE 3 21550017 CMDERR2 MVI CMDERLST+5,1 INVALID USERID FIELD 21600017 B CMDERR20 21650017 SPACE 3 21700017 CMDERR3 MVI CMDERLST+5,4 DIGITS TOO LONG 21750017 B CMDERR20 21800017 SPACE 3 21850017 CMDERR4 MVI CMDERLST+5,2 INVALID PROTECTION KEY FIELD 21900017 B CMDERR20 21950017 SPACE 3 22000017 CMDERR5 MVI CMDERLST+5,8 ILLEGAL COMMA 22050017 B CMDERR20 22100017 SPACE 3 22150017 CMDERR6 MVI CMDERLST+5,9 INVALID JOBNAME FIELD 22200017 B CMDERR20 22250017 SPACE 3 22300017 CMDERR7 MVI CMDERLST+5,10 MESSAGE FIELD TOO LONG 22350017 B CMDERR20 22400017 SPACE 3 22450017 CMDERR10 MVI CMDERLST+5,12 ILLEGAL CONTINUATION 22500017 B CMDERR20 22550017 SPACE 3 22600017 CMDERR11 EQU CMDERR5 MISSING QUOTE 22650017 SPACE 3 22700017 CMDERR14 MVI CMDERLST+5,6 INVALID TERMID 22750017 B CMDERR20 22800017 SPACE 3 22850017 CMDERR15 MVI CMDERLST+5,16 UNDEFINED KEYWORD 22900017 B CMDERR20 22950017 SPACE 3 23000017 CMDERR16 MVI CMDERLST+5,17 INVALID MSG NUMBER FIELD 23050017 B CMDERR20 23100017 SPACE 3 23150017 CMDERR17 MVI CMDERLST+5,5 OPERAND ILLEGAL OR OMITTED 23200017 B CMDERR20 23250017 SPACE 3 23300017 CMDERR18 MVI CMDERLST+5,18 MULTIPLE USE OF KEYWORD 23350017 SPACE 3 23400017 *ROUTINE TO BUILD PARAMETER LIST FOR BUILDMSG 23450017 SPACE 23500017 CMDERR20 EQU * 23550017 MVI CMDERLN,17 LENGTH OF PARAMETERS 23600017 MVI CMDERLST+15,C' ' MOVE BLANK BEFORE SEQUENCE 000B 23650017 MVC CMDERLST+16(8),72(R3) SEQUENCE NUMBER 23700017 CMDERR23 EQU * 23750017 ST R4,CMDERLST ADDRESS OF TDIR ENTRY 23800017 OC CMDERLST(1),CMDSW INDICATE CALLING ROUTINE 23850017 LR R7,R15 SAVE SCAN'S RETURN CODE 23900017 LR R11,R1 SAVE REG 1 23950017 LA R1,CMDERLST 24000017 L R15,CMDBLDM GET ADDRESS FO BUILDMSG 24050017 BALR R14,R15 CALL BUILDMSG 24100017 CMDERR25 MVI CMDERSW,4 SET ERROR INDICATOR 24150017 CLI CMDSW,0 CHECK CALLING ROUTINE 24200017 BNE CMDINT7 STOP ERROR CHECKING IF C/E 24250017 LR R1,R11 RESTORE REG 1 24300017 LR R15,R7 RESTORE SCAN'S RETURN CODE 24350017 BR R9 24400017 * 24450017 *********************************************************************** 24500017 SPACE 24550017 *WORK AREAS AND CONSTANTS 24600017 SPACE 24650017 *********************************************************************** 24700017 SPACE 3 24750017 *THERE ARE TWO IDENTICAL WORK AREAS SO THAT TWO COMMANDS CAN BE 24800017 *PROCESSED AT THE SAME TIME. THIS AREA CONTAINS PARAMETER LISTS,SAVE 24850017 *AREA,SWITCHES,AND THE 95-BYTE EXTENDED CARD IMAGE. 24900017 SPACE 24950017 CMDPASS1 DC 57F'0' WORK AREA FOR ENTRY FROM C/E A32850 25000020 CMDPASS2 DC 57F'0' WORK AREA FOR ENTRY FROM ENTRY RDR A32850 25050020 * OR CENTRL COMMANDS A32850 25100020 SPACE 3 25150017 *PARAMETER LIST FOR MESSAGE SCAN 25200017 SPACE 25250017 CMDMSLST DC F'0' ADDRDSS OF LEADING QUOTE 25300017 DC F'0' ADDRESS OF END OF CARD 25350017 DC F'0' MAXIMIM ALLOWABLE MSG LENGTH 25400017 SPACE 3 25450017 *RECORD PASSED TO PROCESSING ROUTINES 25500017 SPACE 25550017 IHKCACOM DS 0F 25600017 CMDPARM DS F ADDRESS OF TDIR ENTRY 25650017 DC X'FF' INDICATION FOR Q-MGR TO RESETPL 25700017 DC AL3(CMDPASS2+40) ADDRESS OF 95-BYTE CARD IMAGE 25750017 CMDAADSP DC V(IHKAADSP) DISPATCHER 25800017 CMDSCAN DC V(IHKCCSCN) ADDRESS OF SCAN 25850017 CMDCDTMR DC V(IHKCDTMR) 25900017 CMDBLDM DC V(IHKCBLDM) 25950017 DC V(IHKCDSCH) 26000017 DC V(IHKCCSGN) 26050017 DC V(IHKCCPLM) 26100017 DC A(IHKCDLLN) 26150017 CMDCBSTD DC V(IHKCBSTD) 26200017 CMDCCSUD DC V(IHKCCSUD) 26250017 DC A(IHKCDLNB) 26300017 DC V(IHKCDUMR) 26350017 DC A(IHKCDLNT) 26400017 DC A(IHKCDUDR) 26450017 DC A(IHKCDULN) 26500017 DC A(IHKCDUNB) 26550017 DC A(IHKCDFTB) 26600017 DC A(IHKCDFLN) 26650017 DC A(IHKCDFNB) 26700017 DC A(IHKCDTDR) 26750017 DC A(IHKCDTLN) 26800017 DC A(IHKCDTNB) 26850017 DC V(IECTLERP) 26900017 DC A(IHKCDCBS) 26950017 DC V(IHKCDFMR) 27000017 DC V(IHKCDJMR) 27050017 DC A(IHKCDSOC) 27100017 DC A(IHKCDFES) 27150017 DC V(IHKCDCMR) ADDRESS OF IHKCDCMR 27200017 DC V(IHKCDOMR) 27250017 DC A(IHKCDJLN) 27300017 DC F'0' RJE START PARMETER LIST ADDR000B 27350017 DC A(IHKAALST+8) CENTRAL COMMANDS ECB IN DISP 27400017 DC V(IHKCHRDR) RJE READER ENTRY POINT 000B 27450017 DC V(IHKCEDIT) RJE JCL EDIT ENTRY POINT 27500017 DC F'0' NEL PASSED ON TO OS R/I 27550017 DC V(IHKCHASE) READER EODAD ENTRY 000B 27600017 DC A(IHKCBSAE) SYSDEQ STP ACK ECB 27650017 DC A(IHKCDRCS) STOP SWITCHES 27700017 CMDCCQMG DC V(IHKCCQMG) 27750017 DC V(IHKBBCCR) 27800017 DC V(IHKRJBGN) 27850017 DC V(IHKCHSDQ) 000B 27900017 DC F'0' C/E PARAMETER LIST 27950017 DC V(IHKABLWT) LINE ANALYSIS WRITE 28000017 DC V(IHKABLST) LINE SCHEDULER 28050017 DC A(IHKCCECB) POOL MGR'S ECB LIST 28100017 DC A(IHKCCBUF) 28150017 DC F'0' ENTRY POINT OF IEFQMSSS STORED BY NIP 000B 28200017 DC F'0' ENTRY POINT OF IEFQDELE STORED BY NIP 000B 28250017 DC F'0' ENTRY POINT OF IEFQMDQ2 STORED BY NIP 000B 28300017 DC F'0' ENTRY POINT OF IEFSD447 STORED BY NIP 000B 28350017 DC F'0' RDR QMGR ECB ADDRESS 000B 28400017 DC F'0' SYSDQ QMGR ECB ADDRESS 000B 28450017 DC V(IHKCAMSN) 000C 28510018 DC A(IHKCHOFS) 000C 28570018 DC A(IHKCHUM0) 000C 28630018 EXTRN IHKCHOFS,IHKCHUM0 000C 28690018 EXTRN IHKCCBUF 28750017 EXTRN IHKCCECB 28800017 EXTRN IHKCDFTB,IHKCDFLN,IHKCDFNB,IHKCDUDR,IHKCDULN,IHKCDUNB 28850017 EXTRN IHKCDTDR,IHKCDTLN,IHKCDTNB,IHKCDLNT,IHKCDLLN,IHKCDLNB 28900017 EXTRN IHKCDCBS,IHKCDSOC,IHKCDFES 28950017 EXTRN IHKCDJLN,IHKAALST,IHKCBSAE,IHKCDRCS 29000017 ENTRY IHKCACOM 29050017 SPACE 3 29100017 *V-CONS FOR LINKAGE TO COMMAND PROCESSING ROUTINES 29150017 SPACE 29200017 CMDRTNS DS 0F 29250017 CMDMSN DC V(IHKCAMSN) MSG SCAN 29300017 DC C'BLGN' 000A 29350017 DC C'BRJS' 000A 29400017 DC C'GDLT' 000A 29450017 DC C'BLGF' 000A 29500017 DC C'FBDR' 000A 29550017 DC C'FOUT' 000A 29600017 DC C'FSTA' 000A 29650017 DC C'ARJN' 000A 29700017 DC C'HCNT' CENOUT 000B 29750017 DC C'DBDC' BRDCST 29800017 DC C'BUID' USERID 29850017 SHOWNAME EQU * 000B 29900017 DC C'ASHO' SHOW 29950017 DC C'FMSG' 000A 30000017 DC C'FMSG' 000A 30050017 DC C'GALT' 000A 30100017 DC C'BRJS' 000A 30150017 DC C'ARJN' 000A 30200017 DC C'ARJN' 000A 30250017 SPACE 3 30300017 CMDEPLOC DC CL4'IHKC' 30350017 CMDNAME DC CL4' ' 30400017 SPACE 3 30450017 *LENGTHS OF THE VARIOUS FIELDS 30500017 SPACE 30550017 CMDUSELN DC H'3' LENGTH OF USERID FIELD 30600017 CMDKEYLN EQU CMDUSELN LENGTH OF PROTECTION 000A*30650017 KEY FIELD 000A 30700017 CMDJOBLN DC H'8' MAXIMUM LENGTH OF JOBNAME 30750017 CMDTRMLN EQU CMDJOBLN MAXIMUM LENGTH OF TERMID 000A 30800017 CMDCALLN DC H'15' LENGTH OF DIAL DIGITS 30850017 CMDLINLN EQU CMDJOBLN LENGTH OF LINE NAME 000A 30900017 CMDHALF2 DC H'2' 000A 30950017 CMDHALF1 DC H'1' 000A 31000017 SPACE 3 31050017 *KEYWORD PARAMETERS 31100017 SPACE 31150017 CMDJOB DC CL2'J=' 31200017 CMDUSER DC CL2'U=' 31250017 CMDTERM DC CL2'T=' 31300017 CMDTEXT DC CL2'M=' 31350017 CMDDELET DC CL2'D=' 31400017 CMDNO DC CL10'BRDCST=NO' 31450017 ORG *-3 000A 31500017 CMDNO2 DS CL3 'NO ' 000A 31550017 CMDYES DC CL11'BRDCST=YES' 31600017 CMDBEGIN DC CL6'BEGIN' 31650017 CMDPACK DC CL5'PACK' 31700017 CMDELETE DC CL7'DELETE' 31750017 CMDDIAL DC CL5'CALL=' 31800017 CMDACTA DC CL4'ADD' 31850017 CMDBLCOM DC C' , ' 000A 31900017 CMDCOMBL EQU CMDBLCOM+1 000A 31950017 CMDASTER DC C'* ' 000A 32000017 CMDSLASH DC C'/ ' 000A 32050017 SPACE 32100017 CMDTABLE DC CL8'JOBS' LIST OF OPERANDS FOR SHOW 32150017 DC CL8'TERMS' 32200017 DC CL8'USERS' 32250017 DC CL8'ACTIVE' 000B 32300017 DC CL8'DEFER' 32350017 DC CL8'MSGS' 32400017 DC CL8'BRDCST' 32450017 ORG *-3 000A 32500017 CMDSTAT DS CL2,C 'T ' 000A 32550017 CMDLIMIT DC CL8'LERB' 32600017 LOGOFF DS 0CL7 000B 32650017 DC X'000D' OFFSET AND LENGTH FOR LOGOFF000B 32700017 DC C' ' 000B 32750017 USEROFF DC CL4' ' SPACE FOR USERID FOR LOGOFF 000B 32800017 SPACE 3 32850017 *INSTRUCTIONS FOR EXECUTE 32900017 SPACE 32950017 CMDINST1 MVC CMDINFO+2(0),0(R6) MOVE JOBNAME OR USERID TO 83-90 33000017 CMDINST2 MVC CMDTEMP(0),0(R6) MOVE SHOW'S KEYWORD TO TEST IT 33050017 CMDINST3 MVC CMDINFO+4(0),0(R10) MOVE TERMID OR KEY TO 85-90 33100017 CMDINST4 MVC CMDINFO+1(0),0(R6) MOVE TERMID OR USERID TO 82-89 33150017 CMDINST5 MVC CMDERLST+7(0),0(R6) MOVE OPERATION FIELD TO PARM 33200017 TITLE 'COMMAND INTERPRETER-LOGON/USERID' 33250017 *********************************************************************** 33300017 *INPUT- 33350017 * 33400017 * REGISTER 1 IS POINTING TO THE FIRST BLANK PAST THE OPERATION FIELD 33450017 * OF ONE OF THE FOLLOWING COMMANDS 33500017 * 33550017 * .. LOGON USERID,KEY 33600017 * // USERID USERID,KEY,ADD 33650017 * // USERID USERID,KEY,DELETE 33700017 * 33750017 *OUTPUT- 33800017 * THE FOLLOWING 95-BYTE RECORD 33850017 * BYTES1-80 CARD IMAGE OF COMMAND 33900017 * 81 L-FOR LOGON 33950017 * U-FOR USERID 34000017 * 82-84 USERID 34050017 * 85-87 KEY 34100017 * 88 A-FOR ADD 34150017 * D-FOR DELETE 34200017 * 34250017 * ERRORS ARE RECOGNIZED IN THE FOLLOWING SITUATIONS 34300017 * 34350017 * 1.NO OPERAND IS FOUND 34400017 * 2.USERID IS OTHER THAN 3 CHARACTERS LONG 34450017 * 3.NO KEY IS FOUND 34500017 * 4.KEY IS OTHER THAN 3 CHARACTERS LONG 34550017 * 5.COMMA FOLLOWS KEY-LOGON 34600017 * 6.NO KEYWORD-USERID 34650017 * 7.UNDEFINED KEYWORD-USERID 34700017 * 8.NO DELIMITER(BLANK OR COMMA) IS FOUND 34750017 * 9.ILLEGAL CONTINUATION 34800017 ********************************************************************** 34850017 SPACE 3 34900017 *SET UP PARAMETERS FOR LOGON COMMAND 34950017 SPACE 35000017 CMDL MVI CMDINFO,C'L' MMOVE LOGON CODE TO BYTE 81 35050017 B CMDLU1 35100017 SPACE 3 35150017 *SET UP PARAMETERS FOR USERID COMMAND 35200017 SPACE 35250017 CMDU MVI CMDINFO,C'U' MOVE USERID CODE TO BYTE 81 35300017 SPACE 3 35350017 *CHECK USERID FIELD 35400017 SPACE 35450017 CMDLU1 BAL R11,CMDINT20 SCAN FOR 1ST NON-BLANK 35500017 SPACE 35550017 B CMDERR17 ERROR CONDITION-NO OPERAND 35600017 BAL R2,CMDINT40 SCAN FOR BLANK OR COMMA AND CHEC35650017 THE RETURN CODE 35700017 SPACE 3 35750017 BAL R11,CMDINT30 GET LENGTH AND CHECK FOR ZERO 35800017 CH R1,CMDUSELN CHECK FOR 3 CHARACTER USERID 35850017 BE CMDLU2 VALID USERID 35900017 BAL R9,CMDERR2 ERROR CONDITION-INVALID USERID 35950017 LA R9,CMDINT7 RESTORE RETURN REG 36000017 B CMDLU3 CONTINUE SCAN FOR OTHER ERRORS 36050017 CMDLU2 EX R1,CMDINST4 36100017 SPACE 3 36150017 CMDLU3 CLI 0(R10),C' ' CHECK FOR END OF OPERAND 36200017 BE CMDLU5 36250017 LA R1,1(R10) MOVE TO NEXT FIELD 36300017 BAL R2,CMDINT40 SCAN FOR BLANK OR COMMA AND CHEC36350017 THE RETURN CODE 36400017 SPACE 3 36450017 *CHECK KEY FIELD 36500017 SPACE 36550017 CMDLU6 SR R1,R6 FIND LENGTH 36600017 CH R1,CMDKEYLN CHECK FOR LENGTH OF 3 36650017 BE CMDLU7 36700017 CMDLU5 BAL R9,CMDERR4 ERROR CONDITION-INVALID USERID 36750017 LA R9,CMDINT7 RESTORE RETURN REG 36800017 B CMDLU8 36850017 CMDLU7 LR R6,R10 36900017 L R10,CMDSCLST+4 POSITION OF KEY 36950017 EX R1,CMDINST3 MOVE KEY TO BYTES 85-87 37000017 SPACE 37050017 CMDLU8 B *(R15) CHECK SCANS'S RETURN CODE 37100017 B CMDLU14 BLANK FOUND 37150017 SPACE 37200017 CLI CMDINFO,C'L' CHECK FOR LOGON 37250017 BE CMDERR5 ERROR CONDITION-ILLEGAL COMMA 37300017 SPACE 3 37350017 *CHECK KEYWORD FOR USERID 37400017 SPACE 37450017 LA R1,1(R6) 37500017 BAL R2,CMDINT40 SCAN FOR BLANK OR COMMA AND CHEC37550017 THE RETURN CODE 37600017 SPACE 37650017 L MVI 0(R1),C' ' C 37700017 CLC CMDACTA,0(R6) CHECK FOR 'ADD' 37750017 BE CMDLU10 37800017 CLC CMDELETE,0(R6) CHECK FOR 'DELETE' 000B 37850017 BNE CMDERR15 ERROR CONDITION- UNDEFINED KEYW 37900017 SPACE 37950017 MVI CMDINFO+7,C'D' PUT 'DELETE' CODE IN BYTE 88 38000017 B CMDINT35 CHECK FOR END OF OPERAND 38050017 SPACE 3 38100017 CMDLU10 MVI CMDINFO+7,C'A' PUT 'ADD' CODE IN BYTE 88 38150017 B CMDINT35 CHECK FOR END OF OPERAND 38200017 SPACE 3 38250017 *NO KEYWORD IS FOUND 38300017 SPACE 38350017 CMDLU14 CLI CMDINFO,C'U' CHECK FOR USERID COMMAND 38400017 BE CMDERR17 ERROR CONDITION-NO KEYWORD 38450017 SPACE 3 38500017 *CHECK TABLES TO SEE IF USER IS VALID 38550017 SPACE 38600017 CLI CMDERSW,0 CHECK FOR ERRORS 38650017 BCR 7,R9 RETURN IF THERE WERE ERRORS 38700017 L R1,CMDINFO GET USERID 38750017 SLL R1,8 LEFT ADJUST USERID FORSEARCH 38800017 L R15,CMDCCSUD 38850017 BALR R14,R15 38900017 SPACE 38950017 LTR R1,R1 CHECK RETURN CODE 39000017 BZ CMDERR2 ERROR CONDITION-INVALID USERID 39050017 SPACE 3 39100017 *USER IS IN DIRECTORY-CHECK KEY 39150017 SPACE 39200017 USING UDIREC,R1 39250017 CLC UDIRKEY,0(R10) COMPARE KEY 39300017 BNE CMDERR4 ERROR CONDITION-INVALID KEY 39350017 SPACE 3 39400017 *CHECK TO SEE IF USER IS ALREADY LOGGED ON SOMEWHERE ELSE 39450017 SPACE 39500017 CLC TDIRTERM,UDIRTERM CHECK TERMINAL WHERE LOGGING ON 39550017 BE CMDLU30 BBRANCH IF LAST LOGGED ON AT THIS39600017 TERMINAL 39650017 LA R1,UDIRTERM 39700017 L R15,CMDCBSTD 39750017 BALR R14,R15 SEARCH TDIR 39800017 LTR R15,R15 CHECK RETURN CODE 39850017 BNZ CMDLU30 BRANCH IF TERMID NOT FOUND 39900017 DROP R4 39950017 USING TDIREC,R1 40000017 CLC TDIRUSID,CMDINFO+1 CHECK TERMINAL WHERE USER WAS *40050017 LAST LOGGED ON 40100017 BE CMDERR19 ERROR CONDITION/LOGON REJECTED 40150017 CMDLU30 EQU * 40200017 LR R1,R4 ADDRESS OF TDIRENTRY 40250017 BR R9 RETURN TO MAIN ROUTINE 40300017 TITLE 'COMMAND INTERPRETER-STATUS/ALERT/DELETE/OUTPUT' 40350017 *********************************************************************** 40400017 *INPUT- 40450017 * 40500017 * REGISTER 1 IS POINTING TO THE FIRST BLANK PAST THE OPERATION FIELD 40550017 * OF ONE OF THE FOLLOWING COMMANDS 40600017 * 40650017 * .. STATUS 40700017 * .. STATUS J=JOBNAME 40750017 * .. STATUS U=USERID 40800017 * .. STATUS T 40850017 * .. STATUS * 40900017 * 40950017 * .. ALERT 41000017 * .. ALERT JOBNAME 41050017 * .. ALERT J=JOBNAME 000B 41100017 * .. ALERT * 41150017 * .. ALERT / 41200017 * 41250017 * .. DELETE 41300017 * .. DELETE J=JOBNAME 000B 41350017 * .. DELETE JOBNAME 41400017 * 41450017 * .. OUTPUT 000A 41500017 * .. OUTPUT J=JOBNAME 41550017 * .. OUTPUT U=USERID 41600017 * .. OUTPUT * 41650017 * 41700017 *OUTPUT- 41750017 * THE FOLLOWING 95-BYTE RECORD 41800017 * BYTES1-80 CARD IMAGE OF THE COMMAND 41850017 * BYTE81 D-FOR DELETE COMMAND 41900017 * O-FOR OUTPUT COMMAND 41950017 * S-FOR STATUS COMMAND 42000017 * A-FOR ALERT COMMAND 42050017 * BYTE82 BINARY ZERO IF NO OPERAND IS FOUND 42100017 * * IF * SPECIFIED 42150017 * / IF / SPECIFIED (ALERT ONLY) 42200017 * T IF T SPECIFIED (STATUS ONLY) 42250017 * U IF USERID SPECIFIED 42300017 * J IF JOBNAME SPECIFIED 42350017 * BYTES83-85 USERID IF U IN BYTE 82 42400017 * BYTES83-90 JOBNAME IF J IN BYTE 82 42450017 * BYTES83-90 BLANK OTHERWISE 42500017 * 42550017 * 42600017 * ERRORS ARE RECOGNIZED IN THE FOLLOWING SITUATIONS 42650017 * 42700017 * 1.USERID IS NOT 3 CHARACTERS. 42750017 * 2.JOBNAME IS LONGER THAN 8 CHARACTERS. 42800017 * 3.UNDEFINED KEYWORD-STATUS,OUTPUT. 42850017 * 4.A COMMA NOT SURROUNDED BY BLANKS IS FOUND. 42900017 * 5.NO DELIMITER(BLANK) IS FOUND. 42950017 * 6.ILLEGAL CONTINUATION 43000017 *********************************************************************** 43050017 SPACE 3 43100017 *SET CONDITIONS FOR ALERT COMMAND 43150017 SPACE 43200017 CMDA MVI CMDINFO,C'A' PUT ALERT CODE IN BYTE 81 43250017 BAL R11,CMDINT20 SCAN FOR 1ST NON-BLANK 43300017 B CMDINT4 NO OPERAND 43350017 CLC 0(2,R1),CMDASTER CHECK OPERAND FOR * 000A 43400017 BNE CMDA5 43450017 MVI CMDINFO+1,C'*' PUT CODE IN BYTE 82 43500017 BR R9 RETURN TO MAIN ROUTINE 43550017 CMDA5 CLC 0(2,R1),CMDSLASH 000A 43600017 BNE CMDAD10 43650017 MVI CMDINFO+1,C'/' 43700017 BR R9 RETURN TO MAIN ROUTINE 43750017 SPACE 3 43800017 *SET CONDITIONS FOR DELETE COMMAND 43850017 SPACE 43900017 CMDD MVI CMDINFO,C'D' MOVE DELETE CODE TO BYTE 81 43950017 BAL R11,CMDINT20 SCAN FOR 1ST NON-BLANK 44000017 SPACE 3 44050017 B CMDINT4 RETURN TO MAIN ROUTINE 44100017 SPACE 44150017 CMDAD10 CLC 0(2,R1),CMDCOMBL 000A 44200017 BE CMDINT4 RETURN IF NO OPERAND 44250017 CLC CMDJOB,0(R1) CHECK FOR J=JOBNAME 000B 44300017 BNE CMDNOJEQ 000B 44350017 LA R1,2(R1) IF J= STEP PAST KEYWORD 000B 44400017 CMDNOJEQ DS 0H 000B 44450017 BAL R2,CMDINT40 SCAN FOR BLANK OR COMMA 44500017 BAL R11,CMDINT30 GET LENGTH AND CHECK FOR ZERO 44550017 CH R1,CMDJOBLN CHECK JOBNAME 44600017 BNH CMDAD15 44650017 BAL R9,CMDERR6 ERROR COMDITOIN-INVALID JOBNAME 44700017 B CMDINT35 CHECK FOR END OF OPERAND 44750017 CMDAD15 MVI CMDINFO+1,C'J' 44800017 BCTR R1,R0 000A 44850017 EX R1,CMDINST1 MOVE OPERAND 44900017 B CMDINT35 44950017 SPACE 3 45000017 *SET CONDITIONS FOR OUTPUT COMMAND 45050017 SPACE 45100017 CMDO MVI CMDINFO,C'O' PUT OUTPUT CODE IN BYTE 81 45150017 B CMDOS1 45200017 SPACE 3 45250017 *SET CONDITIONS FOR STATUS COMMAND 45300017 SPACE 45350017 CMDS MVI CMDINFO,C'S' PUT STATUS CODE IN BYTE 81 45400017 SPACE 3 45450017 CMDOS1 BAL R11,CMDINT20 SCAN FOR 1ST NON-BLANK 45500017 B CMDINT4 NO OPERAND 45550017 CLC 0(2,R1),CMDCOMBL CHECK FOR COMMENT 000A 45600017 BE CMDINT4 NO OPERAND 45650017 CLC 0(2,R1),CMDASTER 000A 45700017 BNE CMDOS10 45750017 MVI CMDINFO+1,C'*' PUT CODE IN BYTE 82 45800017 BR R9 RETURN TO MAIN ROUTINE 45850017 CMDOS10 CLC CMDSTAT,0(R1) CHECK FOR TERMINAL 45900017 BNE CMDOS15 45950017 CLI CMDINFO,C'S' CHECK FOR STATUS COMMAND 46000017 BNE CMDOS15 46050017 MVI CMDINFO+1,C'T' PUT CODE IN BYTE 82 46100017 BR R9 RETURN TO MAIN OROUTINE 46150017 CMDOS15 CLC CMDUSER,0(R1) CHECK FOR USERID 000A 46200017 BNE CMDOS20 46250017 LA R1,L'CMDUSER(R1) MOVE PAST KEYWORD 000A 46300017 MVI CMDINFO+1,C'U' PUT USERID CODE IN BYTE 82 46350017 BAL R2,CMDINT40 SCAN FOR BLANK OR COMMA 46400017 BAL R11,CMDINT30 GET LENGTH AND CHECK FOR ZEOR 46450017 CH R1,CMDUSELN CHECK USERID LENGTH 46500017 BE CMDOS25 BRANCH IF GOOD 46550017 BAL R9,CMDERR2 ERROR CONDITION-INVALID USERID 46600017 B CMDINT35 CHECK FOR END 46650017 SPACE 3 46700017 CMDOS20 CLC CMDJOB,0(R1) CHECK FOR JOBNAME 46750017 BNE CMDERR15 ERROR COMDITION-UNDEFINED KEYWD 46800017 LA R1,L'CMDJOB(R1) MOVE PAST KEYWORD 46850017 MVI CMDINFO+1,C'J' PUT JOB CODE IN BYTE 82 46900017 BAL R2,CMDINT40 CHECK FOR BLANK FOR COMMA 46950017 BAL R11,CMDINT30 FIND LENGTH AND CHECK FOR ZERO 47000017 CH R1,CMDJOBLN CHECK LENGTH 47050017 BH CMDOS30 BRANCH IF TOO LONG 47100017 CMDOS25 EQU * 47150017 EX R1,CMDINST1 MOVE OPERAND 47200017 B CMDINT35 CHECK FOR END 47250017 CMDOS30 BAL R9,CMDERR6 ERROR CONDITION-INVALID JOBNAME 47300017 B CMDINT35 CHEKK FOREND 47350017 TITLE 'COMMAND INTERPRETER-RJSTART' 47400017 *********************************************************************** 47450017 *INPUT- 47500017 * 47550017 * REGISTER 1 IS POINTING TO THE FIRST BLANK PAST THE OPERATION FIELD 47600017 * OF ONE OF THE FOLLOWING COMMANDS 47650017 * 47700017 * .. RJSTART TERMID 47750017 * .. RJSTART TERMID,BRDCST=YES 47800017 * .. RJSTART TERMID,BRDCST=NO 47850017 * .. RJSTART TERMID,CALL=DIGITS 47900017 * .. RJSTART TERMID,BRDCST=YES,CALL=DIGITS 47950017 * .. RJSTART TERMID,BRDCST=NO,CALL=DIGITS 48000017 * 48050017 *OUTPUT- 48100017 * THE FOLLOWING 95-BYTE RECORD 48150017 * BYTES1-80 CARD IMAGE 48200017 * BYTE81 R 48250017 * BYTES82-89 TERMID 48300017 * BYTE90 Y-IF YES SPECIFIED 48350017 * N-OTHERWISE 48400017 * BYTES91-95 BLANK 48450017 * 48500017 * ERRORS ARE RECOGNIZED IN THE FOLLOWING SITUATIONS 48550017 * 1.NO OPERAND IS FOUND. 48600017 * 2.TERMID IS LONGER THAN 8 CHARACTERS. 48650017 * 3.KEYWORD IS UNDEFINED. 48700017 * 4.CALL DIGITS ARE LONGER THAN 15 CHARACTERS. 48750017 * 5.ILLIGAL COMMA. 48800017 * 6.ILLEGAL CONTINUATION. 48850017 *********************************************************************** 48900017 SPACE 3 48950017 *SET CONDITIONS FOR RJSTART COMMAND 49000017 SPACE 49050017 CMDR MVI CMDINFO,C'R' MOVE RJSTART CODE TO BYTE 81 49100017 SPACE 49150017 CMDR1 BAL R11,CMDINT20 SCAN FOR 1ST NON-BLANK 49200017 SPACE 49250017 B CMDERR17 ERROR CONDITION-NO OPERAND 49300017 SPACE 49350017 BAL R2,CMDINT40 SCAN FOR BLANK OR COMMA AND CHEC49400017 THE RETURN CODE 49450017 SPACE 3 49500017 *CHECK TERMID FIELD 49550017 SPACE 49600017 BAL R11,CMDINT30 GET LENGTH AND CHECK FOR ZERO 49650017 CH R1,CMDTRMLN CHECK LENGTH 49700017 BH CMDERR14 ERROR CONDITION-INVALID TERMID 49750017 CMDR4 BCTR R1,R0 000A 49800017 EX R1,CMDINST4 MOVE TERMID TO BYTES 82-89 49850017 CMDR6 B *(R15) CHECK SCAN'S RETURN CODE 49900017 B CMDR8 BLANK-END OF OPERAND 49950017 B CMDR10 COMMA FOUND 50000017 CMDR8 CLI CMDINFO+9,C' ' 50050017 BNE CMDR9 BRANCH IF BRDCST SPECIFIED 50100017 MVI CMDINFO+9,C'N' 'NO' IS DEFAULT 50150017 SPACE 3 50200017 *CHECK TDIR FOR VALID TERMID 50250017 SPACE 50300017 SPACE 50350017 MVI CMDSCLST+3,2 SET TO SCAN FOR TWO CHARACTERS 50400017 CMDR9 EQU * 50450017 LTR R1,R4 CHECK FOR TDIR ADDRESS GIVEN 50500017 BNZ CMDR94 BRANCH IF GIVEN 50550017 LA R1,CMDINFO+1 ADDRESS OF TERMID 50600017 L R15,CMDCBSTD 50650017 BALR R14,R15 SEARCH TDIR 50700017 SPACE 50750017 LTR R15,R15 CHECK RETURN CODE 50800017 B CMDR96 CHECK RETURN 50850017 CMDR94 EQU * 50900017 CLC TDIRTERM,CMDINFO+1 COMPARE TERMIDS 50950017 CMDR96 EQU * 51000017 BNE CMDERR14 ERROR CONDITION-INVALID TERMID 51050017 BR R9 RETURN TO MAIN ROUTINE 51100017 SPACE 3 51150017 *CHECK BRDCST FIELD 51200017 SPACE 51250017 CMDR10 EQU * 51300017 MVI 0(R10),C',' REPLACE COMMA 51350017 LA R1,1(R10) MOVE PAST LAST COMMA 51400017 BAL R11,CMDINT22 SCAN FOR BLANK OR COMMA 51450017 B CMDERR5 NO DELIMITER 51500017 B CMDR12 BLANK FOUND 51550017 MVI 0(R1),C' ' BLANK OUT COMMA 51600017 SPACE 51650017 CMDR12 CLC CMDYES,0(R6) CHECK FOR 'BRDCST=YES' 51700017 BNE CMDR16 BRANCH IF NOT 'YES' 51750017 CLI CMDINFO+9,C' ' CHECK FOR PREVIOUS USE OF KEYWD 51800017 BNE CMDERR18 ERROR CONDITION-MULTIPLE KEYWD 51850017 SPACE 51900017 CMDR14 MVI CMDINFO+9,C'Y' PUT 'YES' CODE IN BYTE 90 51950017 B CMDR6 CHECK FOR END OF OPERAND 52000017 SPACE 52050017 CMDR16 CLC CMDNO,0(R6) CHECK FOR 'BRDCST=NO' 52100017 BNE CMDR20 BRANCH IF NOT 'NO' 52150017 CLI CMDINFO+9,C' ' CHECK FOR PREVIOUS USE OF KEYWD 52200017 BNE CMDERR18 ERROR CONDITION-MULTIPLE KEYWD 52250017 MVI CMDINFO+9,C'N' PUT 'NO' CODE IN BYTE 90 52300017 B CMDR6 CHECK FOR END OF OPERAND 52350017 SPACE 3 52400017 *CHECK CALL FIELD 52450017 CMDR20 CLC CMDDIAL,0(R6) CHECK FOR 'CALL=' 52500017 BNE CMDR24 BRANCH IF NOT 'CALL=' 52550017 CLI CMDTEMP,C' ' CHECK FOR PREVIOUS USE OF KEYWD 52600017 BNE CMDERR18 ERROR CONDITION-MULTIPLE KEYWD 52650017 MVI CMDTEMP,C'X' INDICATE PRESENCE OF KEYWORD 52700017 LA R6,L'CMDDIAL(R6) MOVE PAST KEYWORD 52750017 SR R1,R6 FIND LENGTH OF CALL DIGITS 52800017 BZ CMDERR3 ERROR CONDITION-INVALID CALL NO 52850017 CH R1,CMDCALLN CHECK LENGTH 52900017 BH CMDERR3 ERROR CONDITION-INVALID CALL NO 52950017 B CMDR6 CHECK FOR END OF OPERAND 53000017 SPACE 3 53050017 CMDR24 CLI 0(R6),C' ' CHECK FOR BLANK FOLLOWING COMMA 53100017 BE CMDERR5 ERROR CONDITION-ILLEGAL COMMA 53150017 BNE CMDERR15 ERROR CONDITION-UNDEFINED KEYWD 53200017 TITLE 'COMMAND INTERPRETER-SHOW' 53250017 *********************************************************************** 53300017 *INPUT- 53350017 * 53400017 * REGISTER 1 IS POINTING TO THE FIRST BLANK PAST THE OPERATION FIELD 53450017 * OF ONE OF THE FOLLOWING COMMANDS 53500017 * 53550017 * // SHOW JOBS 53600017 * // SHOW TERMS 53650017 * // SHOW USERS 53700017 * // SHOW DEFER 53750017 * // SHOW DEFER,USERID 53800017 * // SHOW MSGS 53850017 * // SHOW MSGS,TERMID 53900017 * // SHOW BRDCST 53950017 * // SHOW LERB 54000017 * // SHOW LERB,LINENAME 54050017 * 54100017 *OUTPUT 54150017 * THE FOLLOWING 95-BYTE RECORD 54200017 * BYTES1-80 CARD IMAGE OF COMMAND 54250017 * 81 H 54300017 * 82 J-FOR JOBS 54350017 * T-FOR TERMS 54400017 * U-FOR USERS 54450017 * D-FOR DEFER 54500017 * M-FOR MSGS 54550017 * B-FOR BRDCST 54600017 * L-FOR LERB 54650017 * 83-85 USERID-IF SPECIFIED 54700017 * 83-90 TERMID OR LINENAME IF SPECIFIED 54750017 * 83 BINARY ZERO OTHERWISE 54800017 * 54850017 * ERRORS ARE RECOGNIZED IN THE FOLLOWING SITUATIONS 54900017 * 1.NO OPERAND. 54950017 * 2.USERID IS NOT 3 CHARACTERS. 55000017 * 3.TERMID OR LINENAME GREATER THAN 8 CHARACTERS. 55050017 * 4.UNDEFINED KEYWORD. 55100017 * 5.ILLEGAL COMMA. 55150017 * 6.NO DELIMITER(BLANK OR COMMA) FOUND. 55200017 * 7.ILLEGAL CONTINUATION 55250017 *********************************************************************** 55300017 SPACE 3 55350017 *SET CONDITIONS FOR SHOW COMMAND 55400017 SPACE 55450017 CMDH MVI CMDINFO,C'H' PUT SHOW CODE IN BYTE 81 55500017 SPACE 3 55550017 CMDH1 BAL R11,CMDINT20 SCAN FOR 1ST NON-BLANK 55600017 B CMDERR17 ERROR CONDITION-NO OPERAND 55650017 SPACE 55700017 BAL R2,CMDINT40 SCAN FOR BLANK OR COMMA AND CHEC55750017 THE RETURN CODE 55800017 SPACE 3 55850017 BAL R11,CMDINT30 GET LENGTH AND CHECK FOR ZERO 55900017 CH R1,CMDJOBLN CHECK FOR MAX OPERAND LENGTH 55950017 BH CMDERR15 BRANCH IF TOO LONG 56000017 BCTR R1,R0 000A 56050017 EX R1,CMDINST2 MOVE TABLENAME TO TEST IT 56100017 LA R11,CMDTABLE SET START POSITION FOR BXLE 56150017 LA R6,8 SET INCREMENT REG FOR BXLE LOOP 56200017 LA R7,CMDLIMIT SET COMPARAND FOR BXLE 56250017 SPACE 3 56300017 *BEGINNING OF LOOP TO FIND AND CHECK KEYWORD 56350017 SPACE 56400017 CMDH6 CLC 0(8,R11),CMDTEMP COMPARE OPERAND WITH KEYWORDS 56450017 BE CMDH8 VALID NAME FOUND 56500017 BXLE R11,R6,CMDH6 56550017 SPACE 56600017 *END OF LOOP 56650017 SPACE 3 56700017 B CMDERR15 ERROR CONDITION-UNDEFINED KEYWD 56750017 SPACE 56800017 CMDH8 MVC CMDINFO+1(1),CMDTEMP MOVE CODE TO BYTE 82 56850017 MVC SHOWNAME+3(1),CMDTEMP PUT CODE IN NAME 56900017 B *(R15) CHECK SCAN'S RETURN CODE 56950017 B CMDH12 BLANK FOUND 57000017 SPACE 57050017 CLI CMDINFO+1,C'A' 000B 57100017 BE CMDERR5 000B 57150017 CLI CMDINFO+1,C'B' 000B 57200017 BE CMDERR5 000B 57250017 SPACE 3 57300017 CMDH10 LA R1,1(R10) MOVE PAST COMMA 57350017 BAL R2,CMDINT40 SCAN FOR BLANK OR COMMA AND CHEC57400017 THE RETURN CODE 57450017 SPACE 57500017 BAL R11,CMDINT30 GET LENGTH AND CHECK FOR ZERO 57550017 SPACE 57600017 CLI CMDINFO+1,C'D' CHECK FOR DEFER 57650017 BE CMDH20 57700017 CLI CMDINFO+1,C'U' 000B 57750017 BE CMDH20 000B 57800017 CLI CMDINFO+1,C'J' 000B 57850017 BE CMDH13 000B 57900017 CLI CMDINFO+1,C'T' 000B 57950017 BE CMDH24 000B 58000017 CLI CMDINFO+1,C'M' CHECK FOR MSG 58050017 BE CMDH24 58100017 CH R1,CMDLINLN CHECK LINENAME 58150017 BNH CMDH11 BRANCH IF GOOD 58200017 BAL R9,CMDERR1 ERROR CONDITION-INVALID LINE 58250017 B CMDINT35 CHECK FOR END 58300017 CMDH20 CH R1,CMDUSELN CHECK USERID LENGTH 58350017 BE CMDH11 58400017 BAL R9,CMDERR2 ERROR CONDITION-INVALID USERID 58450017 B CMDINT35 CHECK FOR END 58500017 CMDH24 CH R1,CMDTRMLN CHECK TERMID LENGTH 58550017 BNH CMDH11 BRANCH IF GOOD 58600017 BAL R9,CMDERR14 ERROR CONDITION-INVALID TERMID 58650017 B CMDINT35 CHECK FOR END OF OPERAND 58700017 CMDH13 EQU * 000B 58750017 CH R1,CMDJOBLN CHECK FOR VALID LENGTH 000B 58800017 BNH CMDH11 GO MOVE JOBNAME 000B 58850017 BAL R9,CMDERR6 SEND ERROR MESSAGE 000B 58900017 B CMDINT35 CHECK FOR END 000B 58950017 CMDH11 EQU * 59000017 EX R1,CMDINST1 MOVE USERID OR TERMID TO 83-90 59050017 B CMDINT35 CHECK FOR END OF OPERAND 59100017 SPACE 59150017 CMDH12 MVI CMDINFO+2,0 INDICATE NO USERID OR TERMID 59200017 BR R9 RETURN TO MAIN ROUTINE 59250017 TITLE 'COMMAND INTERPRETER-MSG/MSGR' 59300017 *********************************************************************** 59350017 *INPUT- 59400017 * 59450017 * REGISTER 1 POINTS TO THE FIRST BLANK PAST THE OPERATION FIELD OF 59500017 * ONE OF THE FOLLOWING COMMANDS 59550017 * 59600017 * .. MSG D=TTTTTTTT 59650017 * .. MSG U=UUU,M='MESSAGE' 59700017 * .. MSG T=TTTTTTTT,M='MESSAGE' 59750017 * .. MSG U=UUU,T=TTTTTTTT,M='MESSAGE' 59800017 * .. MSG M='MESSAGE' 59850017 * .. MSGR U=UUU,M='MESSAGE' 59900017 * .. MSGR T=TTTTTTTT,M='MESSAGE' 59950017 * .. MSGR U=UUU,T=TTTTTTTT,M='MESSAGE' 60000017 * .. MSGR M='MESSAGE' 60050017 * 60100017 *OUTPUT- 60150017 * THE FOLLOWING 95- BYTE RECORD 60200017 * BYTES1-80 CARD IMAGE OF COMMAND 60250017 * BYTE81 M-REMOTE 60300017 * G-CENTRAL 60350017 * BYTES82-84 USERID-IF SPECIFIED 60400017 * BINARY ZERO OTHERWISE 60450017 * BYTES85-92 TERMID-IF SPECIFIED 60500017 * BINARY ZERO OTHERWISE 60550017 * BYTE93 DISPLACEMENT FROM BYTE 1 OF LEADING QUOTE 60600017 * BYTE94 DISPLACEMENT FROM BYTE 1 OF TRAILING QUOTE 60650017 * BYTE95 D-IF DELETE SPECIFIED 60700017 * BINARY ZERO OTHERWISE 60750017 * 60800017 * 60850017 * ERRORS ARE RECOGNIZED IN THE FOLLOWING SITUATIONS: 60900017 * 1.NO OPERAND FOUND. 60950017 * 2.TEXT FIELD IS MISSING. 61000017 * 3.DELIMITER(BLANK OR COMMA) IS MISSING. 61050017 * 4.INVALID USERID FIELD. 61100017 * 5.INVALID TERMID FIELD. 61150017 * 6.UNDEFINED KEYWORD. 61200017 * 7.LEFT QUOTE IS MISSING. 61250017 * 8.RIGHT QUOTE IS MISSING. 61300017 * 9.IMBEDDED QUOTE IS NOT DOUBLE. 61350017 * 10.MULTIPLE USE OF KEYWORD 61400017 * 11.DELETE DOES NOT APPEAR AS THE ONLY KEYWORD. 61450017 * 12.ILLEGAL CONTINUATION. 61500017 * 13.DELETE IS SPECIFIED FROM THE REMOTE STATION. 61550017 * 14.THERE IS NO TEXT BETWEEN THE QUOTES. 61600017 *********************************************************************** 61650017 SPACE 3 61700017 CMDM MVI CMDINFO,C'M' PUT REMOTE MSG CODE IN BYTE 81 61750017 B CMDMSG1 61800017 SPACE 61850017 CMDG MVI CMDINFO,C'G' PUT CENTRAL MSG CODE IN BYTE 81 61900017 SPACE 61950017 SPACE 62000017 CMDMSG1 BAL R11,CMDINT20 SCAN FOR 1ST NON-BLANK 62050017 SPACE 3 62100017 B CMDERR17 ERROR CONDITION-NO OPERAND 62150017 MVI CMDSCLST+3,2 SET TO SCAN FOR TWO CHARS 62200017 MVC CMDSCLST+12(2),CMDBLCOM SCAN FOR BLANK OR COMMA 000A 62250017 LA R6,L'CMDUSER(R1) MOVE POINTER PAST KEYWORD 62300017 ST R6,CMDSCLST+4 62350017 SPACE 3 62400017 *CHECK FOR DELETE 62450017 SPACE 62500017 CLC CMDDELET,0(R1) CHECK KEYWORD 62550017 BNE CMDMSG3 62600017 CLI CMDINFO,C'M' DELETE NOT ALLOWED FOR REMOTE 62650017 BE CMDERR15 UNDEFINED KEYWORD 62700017 MVI CMDINFO+14,C'D' PUT DELETE CODE IN BYTE 95 62750017 B CMDMSG10 CHECK TERMID LENGTH 62800017 SPACE 62850017 CMDMSG2 CLI 0(R1),C' ' CHECK FOR OTHER OPERANDS 62900017 BNE CMDERR15 UNDEFINED KEYWORD 62950017 MVI CMDINFO+12,0 INDICATE NO TEXT 63000017 B CMDINT4 RETURN TO MAIN ROUTINE 63050017 SPACE 3 63100017 *CHECK FOR USERID 63150017 SPACE 63200017 CMDMSG3 CLC CMDUSER,0(R1) CHECK KEYWORD 63250017 BNE CMDMSG9 NOT USER 63300017 CLI CMDINFO+1,C' ' CHECK FOR MULTIPLE USE OF KEYWD 63350017 BE CMDMSG4 63400017 BAL R9,CMDERR18 ERROR CONDITION-MULTIPLE KEYWRD 63450017 LA R9,CMDINT7 RESTORE RETURN REG 63500017 CMDMSG4 LA R1,CMDSCLST 63550017 L R15,CMDSCAN ADDRESS OF SCAN ROUTINE 63600017 BALR R14,R15 CALLSCAN 63650017 SPACE 3 63700017 LTR R15,R15 CHECK RETURN CODE FOR ZERO 63750017 BNZ CMDMSG45 BRANCH IF DELIMITER FOUND 63800017 BAL R2,CMDINT42 CHECK FOR BLANK IN COL, 72 63850017 CMDMSG45 EQU * 63900017 LR R6,R1 63950017 S R6,CMDSCLST+4 64000017 CH R6,CMDUSELN CHECK LENGTH OF USERID 64050017 BE CMDMSG5 64100017 BAL R9,CMDERR2 ERROR CONDITION-INVALID USERID 64150017 LA R9,CMDINT7 RESTORE RETURN REG 64200017 B CMDMSG6 64250017 CMDMSG5 L R6,CMDSCLST+4 64300017 LH R10,CMDUSELN LENGTH OF USERID 64350017 BCTR R10,R0 000A 64400017 EX R10,CMDINST4 MOVE USERID TO BYTES 82-84 64450017 SPACE 64500017 CMDMSG6 CLI CMDINFO+14,C'D' CHECK FOR DELETE 64550017 BE CMDMSG2 64600017 B *(R15) CHECK SCAN'S RETURN CODE 64650017 B CMDMSG7 FOLLOWED BY BLANK 64700017 LA R6,L'CMDUSER+1(R1) MOVE POST NEXT KEYWORD 64750017 LA R1,1(R1) MOVE PAST COMMA 64800017 ST R6,CMDSCLST+4 UPDATE SCAN'S START POSITION 64850017 B CMDMSG3 CHECK NEXT KEYWORD 64900017 SPACE 64950017 *END OF OPERAND HAS BEEN REACHED-CHECK FOR TEXT 65000017 SPACE 65050017 CMDMSG7 CLI CMDINFO+12,C' ' 65100017 BE CMDERR17 ERROR CONDITION-NO TEXT 65150017 CLI CMDINFO+1,C' ' CHECK FOR NO USERID 65200017 BNE CMDMSG8 65250017 MVI CMDINFO+1,0 65300017 CMDMSG8 CLI CMDINFO+4,C' ' CHECK FOR NO TERMID 65350017 BNE CMDINT7 RETURN TO MAIN ROUTINE 65400017 MVI CMDINFO+4,0 65450017 BR R9 RETURN TO MAIN ROUTINE 65500017 SPACE 3 65550017 *CHECK FOR TERMID 65600017 SPACE 65650017 CMDMSG9 CLC CMDTERM,0(R1) CHECK KEYWORD 65700017 BNE CMDMSG15 NOT TERM 65750017 CLI CMDINFO+4,C' ' CHECK FOR MULTIPLE USE OF KEYWD 65800017 BE CMDMSG10 65850017 BAL R9,CMDERR18 ERROR CONDITION-MULTIPLE KEYWRD 65900017 LA R9,CMDINT7 RESTORE RETURN REG 65950017 CMDMSG10 LA R1,CMDSCLST 66000017 L R15,CMDSCAN ADDRESS OF SCAN ROUTINE 66050017 BALR R14,R15 CALLSCAN 66100017 SPACE 3 66150017 LTR R15,R15 CHECK RETURN CODE FOR ZERO 66200017 BNZ CMDMSG13 BRANCH IF DELIMITER FOUND 66250017 BAL R2,CMDINT42 CHECK FOR BLANK IN COL 72 66300017 CMDMSG13 EQU * 66350017 LR R6,R1 66400017 S R6,CMDSCLST+4 GET LENGTH OF TERMID 66450017 BE CMDMSG11 ERROR CONDITION-NO TERMID 66500017 CH R6,CMDTRMLN CHECK LENGTH OF TERMID 66550017 BNH CMDMSG12 66600017 SPACE 66650017 CMDMSG11 BAL R9,CMDERR14 ERROR CONDITION-INVALID TERMID 66700017 LA R9,CMDINT7 RESTORE RETURN REG 66750017 B CMDMSG6 66800017 SPACE 66850017 CMDMSG12 L R10,CMDSCLST+4 66900017 BCTR R6,R0 000A 66950017 EX R6,CMDINST3 MOVE TERMID TO BYTES 85-92 67000017 B CMDMSG6 67050017 SPACE 3 67100017 *CHECK FOR TEXT 67150017 SPACE 67200017 CMDMSG15 CLC CMDTEXT,0(R1) CHECK KEYWORD 67250017 BNE CMDMSG22 UNDEFINED KEYWORD 67300017 CLI CMDINFO+12,C' ' CHECK FOR MULTIPLE USE OF KEYWD 67350017 BE CMDMSG17 67400017 BAL R9,CMDERR18 ERROR CONDITION-MULTIPLE KEYWRD 67450017 LA R9,CMDINT7 RESTORE RETURN REG 67500017 SPACE 67550017 CMDMSG17 CLI 0(R6),C'''' CHECK FOR LEFT QUOTE 67600017 BNE CMDERR11 ERROR CONDITION-NO LEFT QUOTE 67650017 SPACE 67700017 LR R1,R6 ADDRESS OF QUOTE 67750017 BAL R11,CMDINT50 CHECK TEXT FIELD 67800017 SPACE 67850017 STC R6,CMDINFO+12 PUT POSITION OF 1ST QUOTE IN 93 67900017 STC R7,CMDINFO+13 PUT POSITION OF 2ND QUOTE IN 94 67950017 MVI CMDINFO+14,0 INDICATE NO 'DELETE' 68000017 SPACE 68050017 BAL R11,CMDINT60 CHECK FOR LENGTH OF ZERO 68100017 SPACE 68150017 CMDMSG21 CLI 1(R8),C' ' CHECK FOR END OF OPERAND 68200017 BE CMDMSG7 BRANCH IF END OF OPERAND 68250017 LA R1,L'CMDUSER+2(R8) MOVE PAST NEXT KEYWORD 68300017 ST R1,CMDSCLST+4 UPDATE SCAN'S START POSITION 68350017 LA R1,2(R8) MOVE TO NEXT KEYWORD 68400017 B CMDMSG3 CHECK NEXT KEYWORD 68450017 SPACE 3 68500017 *UNDEFINED KEYWORD 68550017 SPACE 68600017 CMDMSG22 CLI 0(R1),C' ' 68650017 BE CMDERR5 ERROR CONDITION-ILLEGAL COMMA 68700017 CLI 0(R1),C',' 68750017 BNE CMDERR15 ERROR CONDITION-UNDEFINED KEYWD 68800017 BAL R9,CMDERR15 ERROR CONDITION-UNDEFINED KEYWD 68850017 LA R9,CMDINT7 RESTORE RETURN REG 68900017 LA R1,1(R1) MOVE PAST COMMA 68950017 B CMDMSG3 CONTINUE SCAN 69000017 TITLE 'COMMAND INTERPRETER-BRDCST(CENTRAL)' 69050017 *********************************************************************** 69100017 *INPUT- 69150017 * 69200017 * REGISTER 1 IS POINTING TO THE FIRST BLANK PAST THE OPERATION FIELD 69250017 * OF ONE OF THE FOLLOWING COMMANDS 69300017 * 69350017 * .. BRDCST NN 69400017 * .. BRDCST NN,'TEXT' 69450017 * .. BRDCST ANN,'TEXT' 69500017 * .. BRDCST 'TEXT' 69550017 * .. BRDCST PACK 69600017 * .. BRDCST DELETE 69650017 * 69700017 *OUTPUT 69750017 * THE FOLLOWING 95-BYTE RECORD 69800017 * BYTES1-80 CARD IMAGE 69850017 * BYTE81 T 69900017 * BYTE82 A-IF A SPECIFIED 69950017 * K-IF PACK SPECIFIED 70000017 * D-IF DELETE SPECIFIED 70050017 * BINARY ZERO-IF NONE OF ABOVE SPECIFIED 70100017 * BYTES83-84 MESSAGE NUMBER IF SPECIFIED 70150017 * 'X ' IF NOT SPECIFIED 70200017 * BYTE85 DISPLACEMENT FROM BEGINNING FO CARD OF LEADING QUOTE 70250017 * BINARY ZERO-IF NO TEXT SPECIFIED 70300017 * BYTE86 DISPLACEMENT FROM BEGINNING OF CARD OF TRAILING QUOTE 70350017 * BYTES87-95 BLANK 70400017 * 70450017 * ERRORS ARE RECOGNIZED IN THE FOLLOWING SITUATIONS 70500017 * 1.NO DELIMITER(COMMA OR BLANK) FOUND. 70550017 * 2.'A' SPECIFIED WITH NO TEXT PRESENT. 70600017 * 3.MSG NUMBER IS GREATER THAN 99. 70650017 * 4.UNDEFINED KEYWORD. 70700017 * 5.ILLEGAL COMMA. 70750017 * 6.LEFT QUOTE NOT FOUND. 70800017 * 7.RIGHT QUOTE NOT FOUND. 70850017 * 8.INTERNAL QUOTE NOT DOUBLE. 70900017 * 9.MSG NUMBER IS NON-NUMERIC 70950017 * 10.MSG IS LONGER THAN 40 CHARACTERS. 71000017 * 11.NO TEXT BETWEEN QUOTES. 71050017 * 12.NO OPERAND FOUND. 71100017 * 13.ILLEGAL CONTINUATION. 71150017 *********************************************************************** 71200017 SPACE 3 71250017 CMDT MVI CMDINFO,C'T' PUT BRDCST CODE IN BYTE 81 71300017 CMDT1 BAL R11,CMDINT20 SCAN FOR NON-BLANK 71350017 SPACE 71400017 B CMDERR17 ERROR CONDITION-NO OPERAND 71450017 SPACE 3 71500017 *CHECK OPERAND 71550017 SPACE 71600017 CLI 0(R1),C'''' CHECK FOR TEXT 71650017 BNE CMDT2 71700017 MVI CMDINFO+1,0 INDICATE NO KEYWORDS SPECIFIED 71750017 MVI CMDINFO+2,C'X' INDICATE NO MSG NO. 71800017 B CMDT22 SCAN MSG FIELD 71850017 SPACE 71900017 CMDT2 BAL R2,CMDINT40 SCAN FOR BLANK OR COMMA AND CHEC71950017 THE RETURN CODE 72000017 SPACE 72050017 MVI CMDINFO+1,0 INDICATE NO KEYWORD 72100017 CLI 0(R6),C'A' CHECK FOR 'A' PRECEDING MSG NO. 72150017 BNE CMDT4 72200017 B *(R15) CHECK SCAN'S RETURN CODE 72250017 B CMDERR5 ERROR CONDITION-NO TEXT 72300017 MVI CMDINFO+1,C'A' 72350017 LA R6,1(R6) MOVE TO MSG NO. 72400017 CMDT4 MVI 0(R1),C' ' 72450017 BAL R11,CMDINT30 GET LENGTH AND CHECK FOR ZERO 72500017 CH R1,CMDHALF2 CHECK LENGTH 000A 72550017 BH CMDT8 CHECK FOR KEYWORD 72600017 BE CMDT5 72650017 MVI CMDINFO+2,C'0' INSERT LEADING ZERO 72700017 MVC CMDINFO+3(1),0(R6) MOVE MSG NUMBER TO BYTE 84 72750017 B CMDT7 CHECK FOR VALID NUMBER 72800017 CMDT5 MVC CMDINFO+2(2),0(R6) MOVE MSG NO. TO BYTES 83-84 72850017 SPACE 72900017 CMDT7 CLI CMDINFO+2,C'0' 72950017 BL CMDT9 73000017 CLI CMDINFO+2,C'9' CHECK FOR MAXIMUM MSG NO 73050017 BH CMDT9 73100017 CLI CMDINFO+3,C'0' 73150017 BL CMDT9 73200017 CLI CMDINFO+3,C'9' CHECK FOR MAXIMUM MSG NO 73250017 BH CMDT9 73300017 B CMDT10 73350017 SPACE 73400017 CMDT9 BAL R9,CMDERR16 ERROR CONDITION-NOT VALID NO. 73450017 LA R9,CMDINT7 RESTORE RETURN REG 73500017 CMDT10 B *(R15) CMECK SCAN'S RETURN CODE 73550017 B CMDT6 END OF OPERAND 73600017 CLI 1(R10),C'''' CHECK FOR SEFT QUOTE 73650017 BNE CMDERR11 ERROR CONDITION-NO LEFT QUOTE 73700017 LA R1,1(R10) 73750017 B CMDT22 SCAN MSG TEXT 73800017 SPACE 73850017 CMDT6 MVI CMDINFO+4,0 INDICATE TO TEXT 73900017 B CMDINT4 RETURN TO MAIN ROUTINE 73950017 SPACE 3 74000017 *CHECK FOR PACK OR DELETE 74050017 SPACE 74100017 CMDT8 CLC CMDPACK,0(R6) 74150017 BE CMDT14 74200017 CLC CMDELETE,0(R6) 74250017 BE CMDT16 74300017 B *(R15) CHECK SCAN'S RETURN CODE 74350017 B CMDERR15 ERROR CONDITION-UNDEIFNED KEYWD 74400017 SPACE 74450017 CLI 1(R10),C'''' CHECK FOR TEXT FOLLOWING 74500017 BNE CMDERR16 ERROR CONDITION-INVALID MSG NO. 74550017 BAL R9,CMDERR16 ERROR CONDITION-INVALID MSG NO. 74600017 LA R9,CMDINT7 RESTORE RETURN REG 74650017 LA R1,1(R10) ADDRESS OF QUOTE 74700017 B CMDT22 SCAN MSG TEXT 74750017 SPACE 3 74800017 *PACK HAS BEEN RECOGNIZED 74850017 SPACE 74900017 CMDT14 MVI CMDINFO+1,C'K' PUT 'PACK' CODE IN BYTE 82 74950017 B CMDT17 CHECK SCAN'S RETURN CODE 75000017 SPACE 3 75050017 *DELETE HAS BEEN RECOGNIZED 75100017 SPACE 75150017 CMDT16 MVI CMDINFO+1,C'D' PUT 'DELETE' CODE IN BYTE 82 75200017 CMDT17 B *(R15) CHECK SCAN'S RETURN CODE 75250017 B CMDT18 BLANK FOUND 75300017 B CMDERR5 ERROR CONDITION-ILLEGAL COMMA 75350017 SPACE 75400017 CMDT18 MVI CMDINFO+2,C'X' INDICATE NO MSG NUMBER 75450017 MVI CMDINFO+4,0 INDICATE NO TEXT 75500017 BR R9 RETURN TO MAIN ROUTINE 75550017 SPACE 3 75600017 *CHECK MSG TEXT FIELD 75650017 SPACE 75700017 CMDT22 EQU * 75750017 BAL R11,CMDINT50 CHECK TEXT FIELD 75800017 STC R6,CMDINFO+4 PUT POSITION OF 1ST QUOTE IN 85 75850017 STC R7,CMDINFO+5 PUT POSITION OF 2ND QUOTE IN 86 75900017 BAL R11,CMDINT60 CHECK FOR LENGTH OF ZERO 75950017 CMDT30 CLI 1(R8),C',' CHECK FOR COMMA AFTER MSG 76000017 BE CMDERR5 ERROR CONDITION-ILLEGAL COMMA 76050017 BR R9 RETURN TO MAIN ROUTINE 76100017 TITLE 'COMMAND INTERPRETER-LOGOFF' 76150017 *INPUT: 76200017 * REGISTER 2 CONTAINS THE ADDRESS OF TTHE FIRST CHARACTER OF THE 76250017 * LOGOFF COMMAND WHICH HAS THE FOLLOWING FORMAT: 76300017 * .. LOGOFF 76350017 * 76400017 * ERRORS ARE RECOGNIZED ONLY IN THE CASE OF AN ILLEGAL CONTINUATION. 76450017 SPACE 3 76500017 DROP R1 000B 76550017 USING TDIREC,R4 000B 76600017 CMDF DS 0H 000B 76650017 MVC USEROFF(3),TDIRUSID GET USERID FOR LOGOFF 000B 76700017 XC TDIRUSID,TDIRUSID LOGOFF USER IN TDIR 000B 76750017 MVC CMDERLST+5(7),LOGOFF MOVE PARMS TO MSG 000B 76800017 MVC CMDERLST+12(8),72(R3) FINISH MSG 000B 76850017 B CMDERR23 GO TO SEND MESSAGE 000B 76900017 TITLE 'COMMAND INTERPRETER-BRDCST(REMOTE)' 76950017 *********************************************************************** 77000017 *INPUT- 77050017 * 77100017 * THE FOLLOWING COMMAND 77150017 * 77200017 * .. BRDCSTR 77250017 * 77300017 *OUTPUT- 77350017 * THE FOLLOWING 95-BYTE RECORD 77400017 * BYTES1-80 CARD IMAGE OF COMMAND 77450017 * 81 B 77500017 * 82-95 BLANK 77550017 * 77600017 * ERRORS ARE RECOGNIZED ONLY IN THE CASE OF AN ILLEGAL CONTINUATION. 77650017 *********************************************************************** 77700017 SPACE 3 77750017 CMDB MVI CMDINFO,C'B' PUT BROADCAST CODE IN BYTE 81 77800017 BR R9 RETURN TO MAIN ROUTINE 77850017 TITLE 'COMMAND INTERPRETER-RJEND/RJENDF/RJENDC' 77900017 *********************************************************************** 77950017 *INPUT- 78000017 * 78050017 * ONE OF THE FOLLOWING COMMANDS 78100017 * 78150017 * .. RJEND 78200017 * .. RJENDF 78250017 * .. RJENDC 78300017 * 78350017 *OUTPUT 78400017 * THE FOLLOWING 95-BYTE RECORD- 78450017 * BYTES1-80 CARD IMAGE OF COMMAND 78500017 * BYTE81 J-RJEND 78550017 * F-RJENDF 78600017 * C-RJENDC 78650017 * BYTE82-95 BLANK 78700017 * 78750017 * ERRORS ARE RECOGNIZED ONLY IN THE CASE OF AN ILLEGAL CONTINUATION. 78800017 *********************************************************************** 78850017 SPACE 6 78900017 CMDJ MVI CMDINFO,C'J' PUT RJEND CODE IN BYTE 81 78950017 BR R9 RETURN TO MAIN ROUTINE 79000017 SPACE 3 79050017 CMDX MVI CMDINFO,C'F' PUT RJENDF CODE IN BYTE 81 79100017 BR R9 RETURN TO MAIN ROUTINE 79150017 SPACE 3 79200017 CMDY MVI CMDINFO,C'C' PUT RJENDC CODE IN BYTE 81 79250017 BR R9 RETURN TO MAIN ROUTINE 79300017 TITLE 'COMMAND INTERPRETER-CENOUT' 79350017 *********************************************************************** 79400017 *INPUT 79450017 * 79500017 * REGISTER 1 IS POINTING TO THE FIRST BLANK PAST THE OPERATION FIELD 79550017 * OF ONE OF THE FOLLOWING COMMANDS 79600017 * 79650017 * // CENOUT J=JOBNAME 79700017 * 79750017 *OUTPUT- 79800017 * 79850017 * THE FOLLOWING 95-BYTE RECORD 79900017 * BYTES1-80 CARD IMAGE OF COMMAND 79950017 * 81 C 80000017 * 82 J-FOR JOBNAME 80050017 * 83-90 JOBNAME 80100017 * 91-95 BLANK 80150017 * 80200017 * ERRORS ARE RECOGNIZED IN THE FOLLOWING SITUATIONS 80250017 * 80300017 * 1.NO OPERAND. 80350017 * 2.UNDEFINED KEYWORD. 80400017 * 3.JOBNAME GREATER THAN 8 CHARACTERS. 80450017 * 4. ILLEGAL COMMA. 80500017 * 5.ILLEGAL CONTINUATION. 80550017 *********************************************************************** 80600017 SPACE 3 80650017 CMDC MVI CMDINFO,C'C' PUT CENOUT CODE IN BYTE 81 80700017 SPACE 3 80750017 BAL R11,CMDINT20 SCAN FOR FIRST NON-BLANK 80800017 B CMDERR17 ERROR CONDITION-NO OPERAND 80850017 SPACE 80900017 BAL R2,CMDINT40 SCAN FOR BLANK OR COMMA AND CHEC80950017 THE RETURN CODE 81000017 SPACE 3 81050017 *CHECK KEYWORD 81100017 SPACE 81150017 CLC CMDJOB,0(R6) CHECK FOR J= 81200017 BE CMDC4 81250017 SPACE 81300017 BAL R9,CMDERR15 ERROR CONDITION-UNDEFINED KEYWD 81350017 B CMDINT35 CHECK FOR END OF OPERAND 81400017 CMDC4 MVI CMDINFO+1,C'J' PUT JOBNAME CODE IN 82 81450017 LA R6,L'CMDJOB(R6) MOVE PAST KEYWORK 81500017 SPACE 3 81550017 *CHECK JOBNAME 81600017 SPACE 81650017 BAL R11,CMDINT30 GET LENGTH AND CHECK FOR ZERO 81700017 CH R1,CMDJOBLN 81750017 BNH CMDC8 81800017 SPACE 81850017 BAL R9,CMDERR6 ERROR CONDITION-INVALID JOBNAME 81900017 B CMDINT35 CHECK FOR END OF OPERAND 81950017 SPACE 82000017 CMDC8 EQU * 82050017 EX R1,CMDINST1 MOVE JOBNAME OT BYTES 83-90 82100017 B CMDINT35 CHECK FOR END OF OPERAND 82150017 TITLE 'COMMAND INTERPRETER-CONTINUE' 82200017 *********************************************************************** 82250017 *INPUT- 82300017 * 82350017 * REGISTER 1 IS POINTING TO THE FIRST BLANK PAST THE OPERATION FIELD 82400017 * OF ONE OF THE FOLLOWING COMMANDS 82450017 * 82500017 * .. CONTINUE 82550017 * .. CONTINUE NO 82600017 * .. CONTINUE BEGIN 82650017 * 82700017 *OUTPUT- 82750017 * 82800017 * BITS 9 AND 10 OF TDIRSWCH ARE SET AND THE TDIR ENTRY IS WRITTEN TO 82850017 * DISK. BIT CONFIGURATIONS- 82900017 * 82950017 * 01-BEGIN 83000017 * 10-NO 83050017 * 11-NO OPERAND 83100017 * 83150017 * ERRORS ARE RECOGNIZED IN THE FOLLOWING SITUATIONS 83200017 * 83250017 * 1.UNDEFINED KEYWORD. 83300017 * 2.ILLEGAL COMMA. 83350017 * 3.ILLEGAL CONTINUATION. 83400017 *********************************************************************** 83450017 SPACE 3 83500017 USING TDIREC,R4 83550017 CMDN EQU * 83600017 MVI CMDINFO,C'C' CONTINUE CODE 83650017 BAL R11,CMDINT20 SCAN FOR 1ST NON-BLANK 83700017 SPACE 83750017 B CMDN10 NO OPERAND 83800017 SPACE 83850017 BAL R2,CMDINT40 SCAN FOR BLANK OR COMMA AND CHEC83900017 THE RETURN CODE 83950017 SPACE 84000017 CLC 0(2,R6),CMDCOMBL CHECK FOR COMMENTS 000A 84050017 BE CMDN10 BRANCH IF COMMENTS 84100017 SPACE 84150017 MVI 0(R10),C' ' BLANK OUT COMMA 84200017 CLC CMDBEGIN,0(R6) CHECK FOR BEGIN 84250017 BNE CMDN4 BRANCH IF NOT 'BEGIN' 84300017 SPACE 3 84350017 *BEGIN IS FOUND 84400017 SPACE 84450017 MVI CMDTEMP,B'00100000' SET SWITCH FOR BEGIN 84500017 B CMDN12 CHECK FOR END OF OPERAND 84550017 SPACE 84600017 CMDN4 CLC CMDNO2,0(R6) CHECK FOR 'NO' 84650017 BE CMDN6 BRANCH IF 'NO' 84700017 SPACE 84750017 BAL R9,CMDERR15 ERROR CONDITION-UNDEFINED KEYWD 84800017 SPACE 84850017 B CMDINT35 CHECK FOR END OF OPERAND 84900017 SPACE 3 84950017 *NO IS FOUND 85000017 SPACE 85050017 CMDN6 MVI CMDTEMP,B'01000000' SET SWITCH FOR NO 85100017 B CMDN12 85150017 SPACE 3 85200017 *NO OPERAND IS FOUND 85250017 SPACE 85300017 CMDN10 MVI CMDTEMP,B'01100000' SET SWITCH FOR NO OPERAND 85350017 B CMDN14 85400017 SPACE 3 85450017 *CHECK FOR END OF OPERAND 85500017 SPACE 85550017 CMDN12 B *(R15) CHECK SCAN'S RETURN OCDE 85600017 B CMDN14 BLANK-END OF OPERAND 85650017 B CMDERR5 ERROR CONDITION-ILLEGAL COMMA 85700017 CMDN14 OC TDIRSWCH+1(1),CMDTEMP SET CONTINUE SWITCH IN TDIR 85750017 SPACE 3 85800017 *GO TO Q-MGR TO RESETPL FOR CONTINUE COMMAND. 85850017 SPACE 85900017 LA R1,IHKCACOM ADDRESS OF PARAMETR LIST 85950017 L R15,CMDCCQMG ADDRESS OF Q-MGR 86000017 BALR R14,R15 GO TO Q-MGR TO RESETPL 86050017 BR R9 RETURN 86100017 LTORG 86150017 SPACE 6 86200017 *DSECT FOR TDIR ENTRY 86250017 SPACE 86300017 TDIREC DSECT 86350017 TDIRTERM DS CL8 86400017 TDIRUSID DS CL3 86450017 DS CL25 86500017 TDIRSWCH DC 2F'0' 86550017 UDIREC DSECT 86600017 UDIRTERM DS CL8 86650017 DS C 86700017 UDIRUSID DS CL3 86750017 UDIRKEY DS CL3 86800017 SPACE 3 86850017 *THIS IS THE DSECT FOR THE WORK AREAS USED BY THIS ROUTINE,ONE AREA IS 86900017 *USED WHEN ENTERED FROM THE C/E, THE OTHER WHEN ENTERED FROM THE READER 86950017 *OR CENTRAL COMMANDS. 87000017 SPACE 87050017 CMDWORK DSECT 87100017 SPACE 3 87150017 *PARAMETER LIST FOR SCAN1 87200017 SPACE 87250017 DS 0F 87300017 CMDSCLST DS H MAXIMUM SCAN LENGTH 87350017 DS H NUMBER OF SENSITIVE CHARACTERS 87400017 DS F STARTING ADDRESS 87450017 DS F STOPPING ADDRESS 87500017 DS F STRING OF SENSITIVE CHARACTERS 87550017 SPACE 3 87600017 *PARAMETER LIST FOR BUILDMSG 87650017 SPACE 87700017 CMDERLST DS F ADDRESS OF TERMINAL DIRCT ENTRY 87750017 DS X 87800017 CMDOFSET DS X ERROR MESSAGE OFFSET 87850017 CMDERLN DS C LENGTH OF PARAMETERS 87900017 CMDERPRM DS CL17 PARAMETERS 87950017 SPACE 3 88000017 *WORK AREAS AND SWITCHES 88050017 SPACE 88100017 CMDCARD DS 20F WORK AREA FOR COMMAND 88150017 CMDINFO DS 15X EXTENDED INFO 88200017 CMDERSW DS X INDICATES ERRORS 88250017 CMDTEMP DS 8C 88300017 CMDSW DS F INDICATES CALLING ROUTINE 88350017 DS X A32850 88400020 CMDCODE DS H COMMAND CODE 88450017 SPACE 3 88500017 CMDSAVE DS 18F SAVE AREA 88550017 CMDBUSY DS X BUSY FLAG A32850 88570020 END 88600017 ./ ADD SSI=00012781,NAME=IHKCAMSN,SOURCE=0 TITLE 'IHKCAMSN/MESSAGE SCAN' 00600015 *STATUS: 01200015 * CHANGE LEVEL 0 01800015 * 02400015 *FUNCTION/OPERATION: 03000015 * THIS ROUTINE SCANS A GIVEN MESSAGE FOR QUOTE MARKS,RESOLVES 03600015 * IMBEDDED DOUBLE QUOTES TO SINGLE QUOTES,AND CHECKS FOR A MAXIMUM 04200015 * ALLOWABLE MESSAGE LENGTH. THE END OF A TEXT FIELD IS RECOGNIZED BY 04800015 * A SINGLE QUOTE FOLLOWED BY A BLANK, COMMA, OR RIGHT PARENTHESIS. 05400015 * 06000015 *ENTRY POINTS: 06600015 * IHKCAMSN 07200015 * REGISTER 1 CONTAINS THE ADDRESS OF THE FOLLOWING PARAMETER LIST 07800015 * 08400015 * THE FIRST WORD CONTAINS THE ADDRESS OF THE LEADING QUOTE 09000015 * THE SECOND WORD CONTAINS THE ENDING ADDRESS(IE. THE ADDRESS OF THE 09600015 * END OF THE OPERAND FIELD). 10200015 * THE THIRD WORD CONTAINS THE MAXIMUM ALLOWABLE MESSAGE LENGTH. 10800015 * 11400015 *INPUT-N/A 12000015 * 12600015 *OUPTPT-N/A 13200015 * 13800015 *EXTERNAL ROUTINES: 14400015 * IHKCCSCN 15000015 * 15600015 *EXITS-NORMAL: 16200015 *REGISTER 1 CONTAINS THE ADDRESS OF THE FOLLOWING PARAMETER LIST 16800015 * FIRST WORD-ADDRESS OF THE LEADING QUOTE MARK 17400015 * SECOND WORD-ADDRESS OF TRAILING QUOTE AFTER RESOLUTION OF 18000015 * DOUBLE QUOTES 18600015 * THIRD WORK-ADDRESS OF TRAILING QUOTE BEFORE RESOLUTION OF 19200015 * DOUBLE QUOTES 19800015 * CONTROL IS RETURNED TO CALLING ROUTINE WITH ZERO IN REGISTER 15. 20400015 *EXITS-ERROR: 21000015 * THE CONTENT OF REGISTER 1 IS ARBITRARY IF AN ERROR IS FOUND. 21600015 * REGISTER 15 CONTAINS ONE OF THE FOLLOWING RETURN CODES: 22200015 * 0-NO ERRORS FOUND 22800015 * 4-IMBEDDED QUOTE IS NOT DOUBLE,SCAN TERMINATED 23400015 * 8-TRAILING QUOTE IS MISSING 24000015 * 12-MESSAGE EXCEEDS MAXIMUM ALLOWABLE LENGTH 24600015 * 25200015 *ATTRIBUTES: 25800015 * SERIALLY RESUABLE 26400015 * 27000015 *NOTES 27600015 * 28200015 * THE OPERATION OF THIS ROUTINE DEPENDS UPON AN INTERNAL REPRESENTA- 28800015 * TION OF THE EXTERNAL CHARACTER SET WHICH IS EQUIVALENT TO THE ONE 29400015 * USED AT ASSEMBLY TIME. THE CODING HAS BEEN ARRANGED SO THAT REDEFI- 30000015 * NITION OF 'CHARACTER'CONSTANTS,BY REASSEMBLY,WILL RESULT IN A 30600015 * CORRECT ROUTINE FOR THE NEW DEFINITIONS. 31200015 SPACE 3 31800015 IHKCAMSN CSECT 32400015 R0 EQU 0 33000015 R1 EQU 1 33600015 R2 EQU 2 34200015 R3 EQU 3 34800015 R4 EQU 4 35400015 R5 EQU 5 36000015 R6 EQU 6 36600015 R7 EQU 7 37200015 R8 EQU 8 37800015 R9 EQU 9 38400015 R10 EQU 10 39000015 R11 EQU 11 39600015 R12 EQU 12 40200015 R13 EQU 13 40800015 R14 EQU 14 41400015 R15 EQU 15 42000015 B 12(0,R15) 42600015 DC CL8'IHKCAMSN' 43200015 STM R14,R12,12(R13) SAVE REGS 43800015 BALR R12,0 ESTABLISH BASE 44400015 USING *,R12 45000015 ST R13,SAVE+4 45600015 LA R11,SAVE 46200015 ST R11,8(R13) 46800015 LR R13,R11 47400015 LM R6,R8,0(R1) GET PARAMETERS 48000015 LR R0,R6 SAVE QUOTE POSITION 48600015 ST R7,CMDSCLST+8 STOPPING ADDRESS FOR SCAN 49200015 LA R1,1(R6) UPDATE START POSITION FOR SCAN 49800015 LA R7,0 INITIALIZE LENGTH COUNTER 50400015 LR R10,R1 SAVE START POSITION 51000015 MVI CMDENDSW,0 INITIALIZE SW 51600015 XC CMDERSW(4),CMDERSW CLEAR ERROR SWITCH 52200015 CMDMSN10 ST R1,CMDSCLST+4 52800015 LA R1,CMDSCLST 53400015 L R15,CMDSCAN ADDRESS OF SCAN ROUTINE 54000015 BALR R14,R15 SCAN FOR QUOTE 54600015 B *+4(R15) CHECK RETURN CODE 55200015 B CMDERR12 ERROR CONDITION-NO RIGHT QUOTE 55800015 SPACE 3 56400015 CLI 1(R1),C' ' CHECK FOR END 57000015 BE CMDMSN11 57600015 CLI 1(R1),C',' CHECK FOR END 58200015 BE CMDMSN11 58800015 CLI 1(R1),C')' CHECK FOR END 59400015 BNE CMDMSN12 60000015 CMDMSN11 MVI CMDENDSW,1 TURN ON SWITCH 60600015 B CMDMGT14 61200015 CMDMSN12 CLI 1(R1),C'''' CHECK FOR DOUBLE QUOTE 61800015 BNE CMDERR13 ERROR CONDITION-UNMATCHED QUOTE 62400015 SPACE 63000015 LA R7,1(R7) ADD ONE TO LENGTH (FOR QUOTE) 63600015 CMDMGT14 LR R3,R1 SAVE QUOTE POSITION 64200015 L R6,CMDSCLST+4 GET BEGINNING OF MSG SEGMENT 64800015 SR R1,R6 LENGTH OF MSG SEGMENT 65400015 AR R7,R1 ADD TO OVERALL LENGTH 66000015 CR R7,R8 CHECK LENGTH FOR MAX 66600015 BNH CMDMSN15 BRANCH IF GOOD 67200015 MVI CMDERSW+3,12 SET ERROR CODE-MSG TOO LONG 67800015 SPACE 68400015 CMDMSN15 EX R1,CMDINST3 MOVE MESSAGE SEGMENT 69000015 LR R10,R0 69600015 AR R10,R7 70200015 LA R10,1(R10) UPDATE MOVE POSITION 70800015 CLI CMDENDSW,1 CHECK FOR END 71400015 BE CMDMSN16 72000015 LA R1,2(R3) START OF NEXT MSG SEGMENT 72600015 B CMDMSN10 73200015 SPACE 73800015 *END OF LOOP 74400015 CMDMSN16 ST R0,CMDMGLST LEADING QUOTE 75000015 ST R10,CMDMGLST+4 ADDRESS OF TRAILING QUOTE 75600015 ST R3,CMDMGLST+8 ADDRESS OF ORIGINAL TRAILING QT 76200015 LA R1,CMDMGLST 76800015 SPACE 3 77400015 CMDMSN18 L R13,SAVE+4 78000015 L R14,12(R13,0) RESTORE REGS 78600015 L R15,CMDERSW GET ERROR CODE 79200015 LM R2,R12,28(R13) 79800015 MVI 12(R13),X'FF' SET RETURN INDICATION 80400015 BR R14 RETURN 81000015 SPACE 81600015 CMDERR12 MVI CMDERSW+3,8 MISSING TRAILING QUOTE 82200015 B CMDMSN18 82800015 SPACE 83400015 CMDERR13 MVI CMDERSW+3,4 IMBEDDED QUOTE NOT DOUBLE 84000015 B CMDMSN18 84600015 SPACE 3 85200015 SAVE DS 18F 85800015 SPACE 3 86400015 *PARAMETER LIST FOR SCAN 87000015 SPACE 87600015 DS 0F 88200015 CMDSCLST DC H'0' MAXSCAN LENGTH 88800015 DC H'1' NUMBER OF SENSITIVE CHARACTERS 89400015 DS F STARTING ADDRESS 90000015 DS F STOPPING POINT 90600015 DC C'''' QUOTE-SENSITIVE CHARACTER 91200015 SPACE 3 91800015 *RETURN PARAMETER LIST 92400015 SPACE 93000015 CMDMGLST DS F ADDRESS OF LEADING QUOTE 93600015 DS F ADDRESS OF TRAILING QUOTE 94200015 DS F ADDRESS OF ORIGINAL TRAILING QT 94800015 SPACE 95400015 CMDSCAN DC V(IHKCCSCN) ADDRESS OF SCAN ROUTINE 96000015 CMDINST3 MVC 0(0,R10),0(R6) MOVE MSG SEGMENTS 96600015 CMDENDSW DS X INDICATES END QUOTE IS REACHED 97200015 CMDERSW DC F'0' ERROR SWITCH 97800015 END 98400015 ./ ADD SSI=00012830,NAME=IHKCASHB,SOURCE=0 TITLE 'IHKCASHB-SHOW BRDCST' 00500015 *********************************************************************** 01000015 * * 01500015 *FUNCTION/OPERATION- * 02000015 * * 02500015 * THIS ROUTINE PROCESSES THE SHOW BRDCST COMMAND. IT WRITES ALL * 03000015 * BRDCST MESSAGES WITH THEIR SLOT NUMBERS TO THE CENTRAL CONSOLE. * 03500015 * * 04000015 *ENTRY * 04500015 * * 05000015 * IHKCASHB * 05500015 * * 06000015 * REGISTER 1 CONTAINS THE ADDRESS OF IHKCACOM-THE RJE COMMUNICATIONS* 06500015 * REGION. * 07000015 * * 07500015 *INPUT-N/A. * 08000015 * * 08500015 *OUTPUT- * 09000015 * * 09500015 * A LIST OF ALL ACTIVE BRDCST MESSAGES WRITTEN TO THE CENTRAL * 10000015 * CONSOLE. * 10500015 * * 11000015 *EXTERNAL ROUTINES- * 11500015 * * 12000015 * IHKCBLDM-BUILDMSG. BUILDS AND WRITES MESSAGES TO CENTRAL * 12500015 * CONSOLE. * 13000015 * IHKCDMDQ-MESSAGE DEQUEUE. REMOVES ACTIVE BRDCST MESSAGES FROM* 13500015 * THE DATA SET. * 14000015 * * 14500015 *EXITS-NORMAL- * 15000015 * * 15500015 * REGISTER 15 CONTAINS 0. * 16000015 * * 16500015 *EXITS-ERROR- * 17000015 * * 17500015 * REGISTER 15 CONTAINS 0. AN ERROR MESSAGE IS WRITTEN TO THE CENTRAL* 18000015 * CONSOLE, AND PROCESSING STOPS. * 18500015 * * 19000015 *ATTRIBUTES- * 19500015 * * 20000015 * SERIALLY REUSABLE. * 20500015 * * 21000015 *NOTES- * 21500015 * * 22000015 * THE OPERATION OF THIS ROUTINE DEPENDS UPON AN INTERNAL REPRESENTA-* 22500015 * TION OF THE EXTERNAL CHARACTER SET WHICH IS EQUIVALENT TO THE ONE * 23000015 * USED AT ASSEMBLY TIME. THE CODING HAS BEEN ARRANGED SO THAT REDE- * 23500015 * FINITION OF CHARACTER-TYPE CONSTANTS,BY REASSEMBLY,WILL RESULT IN * 24000015 * A CORRECT ROUTINE FOR THE NEW DEFINITIONS. * 24500015 *********************************************************************** 25000015 SPACE 25500015 IHKCASHB CSECT 26000015 R0 EQU 0 26500015 R2 EQU 2 27000015 R1 EQU 1 MSG SLOT POSITION 27500015 R3 EQU 3 28000015 R4 EQU 4 28500015 R5 EQU 5 29000015 R6 EQU 6 29500015 R7 EQU 7 SWITCH 30000015 R8 EQU 8 30500015 R9 EQU 9 31000015 R10 EQU 10 31500015 R11 EQU 11 BRANCH 32000015 R12 EQU 12 BASE 32500015 R13 EQU 13 SAVE AREA 33000015 R14 EQU 14 RETURN 33500015 R15 EQU 15 ENTRY 34000015 SPACE 6 34500015 B 20(R15) 35000015 DC CL16'IHKCASHB 6/2/67' 35500015 STM R14,R12,12(R13) 36000015 BALR R12,0 36500015 USING *,R12 37000015 ST R13,SHBSAVE+4 37500015 LA R11,SHBSAVE 38000015 ST R11,8(R13) 38500015 LR R13,R11 39000015 SPACE 39500015 *END OF STANDARD LINKAGE 40000015 SPACE 3 40500015 USING CMDPARM,R2 41000015 LR R2,R1 SAVE PARAMETR LIST 41500015 SR R7,R7 SET SWITCH TO ZERO 42000015 MVI SHBLNG,44 INITIALIZE BUILDMSG LENGTH 42500015 MVC SHBBFR(4),=CL4' ' 43000015 MVC SHBLIST2-4(4),SHBCDCBS ADDRESS OF DCBS 43500015 MVC SHBLIST2,SHBAADSP 44000015 ST R7,SHBLIST2+4 INITIALIZE TO BEGIN BRDCST 44500015 SPACE 45000015 LOAD EP=IHKCDMDQ 45500015 SHB05 LA R1,SHBLIST2-4 ADDRESS OF PARAMETER LIST 46000015 LR R15,R0 LOAD ENTRY POINT 46500015 BALR R14,R15 BRANCH TO ROUTINE 47000015 SPACE 47500015 CH R15,SHBFOUR CHECK FOR DISK ERROR 48000015 BNH SHB07 BRANCH IF NO DISK ERROR 48500015 SPACE 49000015 STH R15,SHBOFSET PUT ERROR MSG OFFSET IN PARM 49500015 LA R1,SHBLIST1 50000015 B SHB28 50500015 SPACE 51000015 SHB07 EQU * 51500015 LTR R15,R15 CHECK FOR END OF MSGS 52000015 BNZ SHB20 BRANCH IF NO MORE MSGS 52500015 SPACE 3 53000015 SHB10 ST R1,SHBLIST2+4 SAVE SLOT POSITION 53500015 SRL R1,2 DIVIDE BY 4 54000015 SH R1,=H'1' 54500015 CVD R1,SHBCVD 55000015 UNPK SHBBFR(2),SHBCVD(8) 55500015 OI SHBBFR+1,X'F0' 56000015 LA R7,1 TURN ON SWITCH 56500015 SPACE 3 57000015 SHB15 LA R1,SHBPARM 57500015 L R15,CMDCBLDM 58000015 BALR R14,R15 WRITE MSG 58500015 B SHB05 59000015 SPACE 59500015 *END OF LOOP THROUGH BRDCSTMSGS 60000015 SPACE 3 60500015 SHB20 LTR R7,R7 CHECK SWITCH 61000015 BNZ SHB30 61500015 SPACE 62000015 SHB25 MVC SHBBFR(L'SHBMSG2),SHBMSG2 62500015 MVI SHBLNG,L'SHBMSG2 63000015 LA R1,SHBPARM ADDRESS OFF PARAMETER LIST 63500015 SHB28 EQU * 64000015 L R15,CMDCBLDM ADDRESS OF BUILDMSG 64500015 BALR R14,R15 WRITE MSG 65000015 SHB30 EQU * 65500015 DELETE EP=IHKCDMDQ 66000015 L R13,SHBSAVE+4 66500015 RETURN (14,12),T,RC=0 67000015 SPACE 3 67500015 SPACE 3 68000015 *PARAMETER LIST FOR BUILDMSG-DISK ERROR 68500015 SPACE 69000015 SHBLIST1 DC F'0' SEND MSG TO CENTRAL 69500015 SHBOFSET DC H'0' OFFSET 70000015 DC X'0' LENGTH OF PARAMETERS 70500015 SPACE 3 71000015 *PARAMETER LIST FOR IHKCDMDQ 71500015 SPACE 72000015 DS F 72500015 SHBLIST2 DS F 73000015 DS F 73500015 DC A(SHBBFR+4) LOCATION OF BRDCST MSG 74000015 DC X'80000000' 74500015 SPACE 3 75000015 *PARAMETER LIST FOR BUILDMSG-BRDCST MSGS 75500015 SPACE 76000015 SHBPARM DC F'0' SEND MSG TO CENTRAL 76500015 DC H'24' OFFSET 77000015 SHBLNG DC FL1'44' MSG LENGTH 77500015 SHBBFR DC CL64' ' BRDCST MSG 78000015 SPACE 3 78500015 SHBSAVE DS 18F 79000015 SHBCVD DS D 79500015 SHBMSG2 DC CL4'NONE' 80000015 SHBFOUR DC H'4' 80500015 SPACE 3 81000015 CMDPARM DSECT 81500015 DS 2F 82000015 SHBAADSP DS A 82500015 DS 2F 83000015 CMDCBLDM DS A 83500015 DS 2V 84000015 SHBCDMDQ DS V 84500015 DS 16V 85000015 SHBCDCBS DS V 85500015 END 86000015 ./ ADD SSI=02012891,NAME=IHKCASHL,SOURCE=0 *0788555000,630000,645000,660000 000C 00500018 SHL TITLE 'IHKCASHL - SHOW LERB PROCESSOR' 01000018 *********************************************************************** 01500018 * A32879 01700020 * 02000018 *FUNCTION/OPERATION 02500018 * 03000018 * THIS ROUTINE PROCESSES THE SHOW LERB COMMAND. IF A PARTICULAR LINE 03500018 * IS SPECIFIED,IT DISPLAYS THE CURRENT VALUE OF EACH LINE ERROR 04000018 * COUNTER DATA CHECK,NON-TEXT TIME-OUT,AND INTERVENTION REQUIRED) 04500018 * AND OF THE TRANSMISSION COUNTER. IF NO LINE IS SPECIFIED,THE 05000018 * ROUTINE DISPLAYS THESE VALUES FOR ALL LINES SUPPORTED BY RJE. A 05500018 * BTAM ROUTINE IS USED TO WRITE THE VALUES. 06000018 * 06500018 *ENTRY POINT 07000018 * IHKCASHL 07500018 * 08000018 * REGISTER 1 CONTAINS THE ADDRESS OF THE FOLLOWING LIST OF ADDRESSES 08500018 * 1.N/A 09000018 * 2.95-BYTE CARD IMAGE (THE LINE NAME IS IN THE 83RD BYTE. IF NOT 09500018 * SPECIFIED,ZERO IS IN THE 83RD BYTE.) 10000018 * 3-5.N/A 10500018 * 6.IHKCBLDM 11000018 * 7-9.N/A 11500018 * 10.IHKCDLLN 12000018 * 13.IHKCDLNB 12500018 * 14.N/A 13000018 * 15.IHKCDLNT 13500018 * 16-24.N/A 14000018 * 25.IECTLERP 14500018 * 56.IHKCHOFS A32879 14700020 * 15000018 *INPUT-N/A 15500018 * 16000018 *OUTPUT 16500018 * A LIST OF THE CURRENT VALUES OF EACH LINE ERROR ACCUMLATOR 17000018 * ASSOCIATED WITH THE SPECIFIED LINES. THIS IS WRITTEN TO THE A32879 17500020 * REQUESTING CONSOLE. A32879 18000020 * 18500018 *EXTERNAL ROUTINES 19000018 * 19500018 * IHKCBLDM.BUILDMSG. BUILDS AND WRITES ERROR MESSAGES. 20000018 * IECTLERP.LINE ERROR PRINT. PRINTS VALUES OF ACCUMLATORS. 20500018 * 21000018 *EXITS-NORMAL 21500018 * REGISTER 15 CONTAINS ZERO. 22000018 * 22500018 *EXITS-ERROR 23000018 * REGISTER 15 CONTAINS 4 IF A SPECIFIED LINENAME CANNOT BE FOUND IN 23500018 * THE LINETABLE. 24000018 * 24500018 *ATTRIBUTES 25000018 * SERIALLY REUSABLE. 25500018 * 26000018 *NOTES 26500018 * 27000018 * THE OPERATION OF THIS ROUTINE DEPENDS UPON AN INTERNAL REPRESENTA- 27500018 * TION OF THE EXTERNAL CHARACTER SET WHICH IS EQUIVALENT TO THE ONE 28000018 * USED AT ASSEMBLY TIME. THE CODING HAS BEEN ARRANGED SO THAT REDEFI- 28500018 * NITION OF CHARACTER-TYPE CONSTANTS, BY REASSEMBLY,WILL RESULT IN A 29000018 * CORRECT ROUTINE FOR THE NEW DEFINITIONS. 29500018 * 30000018 *********************************************************************** 30500018 IHKCASHL CSECT 31000018 SPACE 1 000A 31500018 *2781 000A 32000018 SPACE 32500018 R0 EQU 0 33000018 R1 EQU 1 33500018 R2 EQU 2 ADDRESS OF CARD IMAGE 34000018 R3 EQU 3 34500018 R4 EQU 4 LENGTH OF LINE TABLE ENTRY 35000018 R5 EQU 5 ELNGTH OF LINE TABLE 35500018 R6 EQU 6 ADDRESS OF LINE TABLE ENTRY 36000018 R7 EQU 7 SWITCH 36500018 R8 EQU 8 DCB ADDRESS FOR LERPRT MACRO 37000018 R9 EQU 9 RELATIVE LINE NUMBER FOR LERPRT 37500018 R10 EQU 10 38000018 R11 EQU 11 BRANCH 38500018 R12 EQU 12 BASE 39000018 R13 EQU 13 SAVE AREA 39500018 R14 EQU 14 RETURN 40000018 R15 EQU 15 ENTRY 40500018 SPACE 3 41000018 SHLOPEN EQU B'00010000' OPEN FLAG IN DCB FLAG 000A 41500018 SHLDCBFL EQU 48 DISPLACEMEMT OF FLAGS IN DCB000A 42000018 SPACE 6 42500018 STM R14,R12,12(R13) 43000018 BALR R12,0 43500018 USING *,R12 44000018 B ARDID 000C 44500018 DC C'IHKCASHL' 000C 45000018 ARDID DS 0H 000C 45500018 ST R13,SHLSAVE+4 46000018 LA R11,SHLSAVE 46500018 ST R11,8(R13) 47000018 LR R13,R11 47500018 SPACE 48000018 *END OF STANDARD LINKAGE 48500018 SPACE 3 49000018 USING SHLCARD,R2 49500018 USING CMDPARM,R3 50000018 USING LINETAB,R6 50500018 SPACE 51000018 LR R3,R1 SAVE PARAMETER 51500018 SR R7,R7 SET SWITCH TO ZERO 52000018 L R6,SHLCDLNT GO TO BEGINNING OF LINETABLE 52500018 L R4,SHLCDLLN 53000018 L R5,SHLCDLNB 53500018 LH R5,0(R5) 54000018 LTR R5,R5 CHECK FOR EMPTY LINETABLE 54500018 BZ SHL44 BRANCH IF ENPTY 55000018 MH R5,0(R4) LENGTH OF LINE TABLE 55500018 AR R5,R6 END OF TABLE 56000018 BCTR R5,0 000C 56500018 LH R4,0(R4) LENGTH OF ENTRY 57000018 L R2,4(R1) SAVE ADDRESS OF CARD 57500018 SPACE 3 58000018 *BEGINNING OF LOOP THROUGH LINE TABLE 58500018 SPACE 59000018 SHL10 CLI SHLLINE,0 CHECK FOR LINE NAME 59500018 BE SHL20 BRANCH IF NOT SPECIFIED 60000018 CLC SHLLINE,LINENAME LOOK FOR MATCH IN LINE TABLE 60500018 BNE SHL30 BRANCH IF MATCH NOT FOUND 61000018 SHL20 MVC SHLDCB,LINEDCB 61500018 MVC SHLRLN,LINERLN 62000018 L R0,SHLRLN RELATIVE LINE NUMBER 62500018 L R1,SHLDCB ADDRESS OF DCB 63000018 TM SHLDCBFL(R1),SHLOPEN CHECK FOR OPEN LINE DCB 000A 63500018 BNO SHL25 000C 64000018 IC R15,CMDMSG PICK UP THE CONSOLE ID A32879 64100020 SLL R15,24 PUT IT IN THE HI ORDER BYTE A32879 64200020 LA R1,0(R1) CLEAR HI ORDER BYTE OF DCB -> A32879 64300020 OR R1,R15 PUT CONSOLE ID IN IT'S PLACE A32879 64400020 L R15,CMDTLERP ADDRESS OF BTAM ROUTINE 64500018 BALR R14,R15 WRITE MSG 65000018 LA R7,1 TURN ON SWITCH 65500018 SHL25 DS 0H 000C 66000018 CLI SHLLINE,0 CHECK FOR LINENAME SPECIFIED 66500018 BNE SHL440 BRANCH IF LINENAME SPECIFIE000C 67000018 SHL30 BXLE R6,R4,SHL10 CONTINUE THROUGH LINE TABLE 67500018 SPACE 68000018 *END OF LOOP THROUGH LINE TABLE 68500018 SPACE 3 69000018 CLI SHLLINE,0 CHECK FOR LINENAME SPECIFIED 69500018 BE SHL44 BRANCH IF NOT SPECIFIED 70000018 SPACE 70500018 SHL440 DS 0H 000C 71000018 LTR R7,R7 CHECK SWITCH 71500018 BNZ SHL44 BRANCH IF ON 72000018 MVC SHLBFR(L'SHLSEQ),SHLSEQ 72500018 LA R1,SHLPARM ADDRESS OF PARAMETER LIST 73000018 L R15,CMDCBLDM ADDRESS OF BUILDMSG 73500018 BALR R14,R15 A WRITE MSG 74000018 LA R15,4 SET ERROR RETURN CODE 74500018 B SHL45 75000018 SHL44 SR R15,R15 SET ERROR RETURN CODE 75500018 SHL45 L R13,SHLSAVE+4 76000018 SPACE 3 76500018 RETURN (14,12),T,RC=(15) 77000018 SPACE 3 77500018 SHLSAVE DS 18F 78000018 SPACE 3 78500018 SHLRLN DC F'0' RELATIVE LINE NUMBER 79000018 SHLDCB DC F'0' DCB 79500018 *PARAMETER LIST FOR BUILDMSG 80000018 SPACE 80500018 SHLPARM DC F'0' SEND MST TO CENTRAL 81000018 DC H'25' OFFSET 81500018 DC FL1'16' LENGTH OF PARAMETERS 82000018 DC CL8'SHOW' 82500018 SHLBFR DC CL8' ' 83000018 SPACE 3 83500018 SHLCARD DSECT 84000018 DS 18F 84500018 SHLSEQ DS CL8 85000018 DS 2C 85500018 SHLLINE DS CL8 86000018 SPACE 3 86500018 LINETAB DSECT 87000018 LINENAME DS CL8 87500018 LINEDCB DS CL4 88000018 LINERLN DS CL4 88500018 SPACE 89000018 CMDPARM DSECT 89500018 DS 5F 90000018 CMDCBLDM DS A 90500018 DS 3V 91000018 SHLCDLLN DS V 91500018 DS 2V 92000018 SHLCDLNB DS V 92500018 DS V 93000018 SHLCDLNT DS V 93500018 DS 9V 94000018 CMDTLERP DS V 94500018 DS 32V A32879 94600020 CMDMSG DS V A32879 94700020 SPACE 95000018 END 95500018 ./ ADD SSI=01012513,NAME=IHKCASHM,SOURCE=0 TITLE 'IHKCASHM-SHOW MSG' 00300017 *3001393000 000B 00600017 *********************************************************************** 00900017 * 01200017 *FUNCTION/OPERATION 01500017 * THIS ROUTINE PROCESSES THE SHOW MSGS COMMAND. IF A TERMINAL IS 01800017 * SPECIFIED,ALL MESSAGES AWAITING THE STARTUP OF THAT TERMINAL ARE 02100017 * WRITTEN TO THE CENTRAL CONSOLE. IF NO TERMINAL IS SPECIFIED,ALL 02400017 * MESSAGES AWAITING THE STARTUP OF EACH TERMINAL ARE WRITTEN TO THE 02700017 * CENTRAL CONSOLE. 03000017 * 03300017 *ENTRY POINT 03600017 * IHKCASHM 03900017 * 04200017 * REGISTER 1 CONTAINS THE ADDRESS OF THE FOLLOWING LIST OF ADDRESSES 04500017 * 1.N/A 04800017 * 2.95-BYTE CARD IMAGE 05100017 * 3.IHKAADSP 05400017 * 4-5.N/A 05700017 * 6.IHKCBLDM 06000017 * 7-10.N/A 06300017 * 11.IHKCBSTD 06600017 * 12-21.N/A 06900017 * 22.IHKCDTDR 07200017 * 23.IHKCDTLN 07500017 * 24.IHKCDTNB 07800017 * 08100017 *INPUT-N/A 08400017 * 08700017 *OUTPUT 09000017 * BRDCST MESSAGES WRITTEN TO THE CENTRAL CONSOLE. 09300017 * 09600017 * 09900017 *EXTERNAL ROUTINES 10200017 * 10500017 * IHKCBLDM-BUILDMSG. BUILDS AND WRITES MESSAGES TO CENTRAL 10800017 * CONSOLE 11100017 * IHKCDMDQ-REMOVES PENDING MESSAGES FROM DISK 11400017 * IHKCBSTD-SEARCH TDIR. SEARCH TDIR FOR A PARTICULAR TERMID. 11700017 * 12000017 *EXITS-NORMAL 12300017 * REGISTER 15 CONTAINS ZERO. 12600017 * 12900017 *EXITS-ERROR 13200017 * REGISTER 15 CONTAINS 4 IF A SPECIFIED TERMID WAS NOT FOUND IN 13500017 * THE TDIR 13800017 * 14100017 *ATTRIBUTES 14400017 * SERIALLY REUSABLE 14700017 * 15000017 *NOTES 15300017 * 15600017 * THE OPERATION OF THIS ROUTINE DEPENDS UPON AN INTERNAL REPRESENTA- 15900017 * TION OF THE EXTERNAL CHARACTER SET WHICH IS EQUIVALENT TO THE ONE 16200017 * USED AT ASSEMBLY TIME. THE CODING HAS BEEN ARRANGED SO THAT REDEFI- 16500017 * NITION OF CHARACTER-TYPE CONSTANTS, BY REASSEMBLY,WILL RESULT IN A 16800017 * CORRECT ROUTINE FOR THE NEW DEFINITIONS. 17100017 *********************************************************************** 17400017 SPACE 17700017 IHKCASHM CSECT 18000017 SPACE 18300017 R0 EQU 0 18600017 R1 EQU 1 18900017 R2 EQU 2 PARAMETER LIST 19200017 R3 EQU 3 ADDRESS OF CARD IMAGE 19500017 R4 EQU 4 LENGTH OF TDIR ENTRY 19800017 R5 EQU 5 LENGTH OF TDIR 20100017 R6 EQU 6 ADDRESS OF TDIR ENTRY 20400017 R7 EQU 7 TDIR SWITCH 20700017 R8 EQU 8 TERMINAL SWITCH 21000017 R9 EQU 9 21300017 R10 EQU 10 21600017 R11 EQU 11 BRANCH 21900017 R12 EQU 12 BASE 22200017 R13 EQU 13 SAVE AREA 22500017 R14 EQU 14 RETURN 22800017 R15 EQU 15 ENTRY 23100017 SPACE 6 23400017 B 20(R15) 23700017 DC CL16'IHKCASHM 7/11/67' 24000017 STM R14,R12,12(R13) 24300017 BALR R12,0 24600017 USING *,R12 24900017 ST R13,SHMSAVE+4 25200017 LA R11,SHMSAVE 25500017 ST R11,8(R13) 25800017 LR R13,R11 26100017 SPACE 26400017 *END OF STANDARD LINKAGE 26700017 USING TDIR,R1 27000017 USING SHMLIST,R2 27300017 LR R2,R1 SAV PARAMETER LIST 27600017 LOAD EP=IHKCDMDQ 000B 27900017 LR R9,R0 SAVE ENTRY OF IHKCDMDQ 000B 28200017 MVC SHMPARM-4(4),SHMCDCBS ADDRESS OF DCBS 28500017 MVC SHMPARM+1(3),SHMAADSP+1 ADDRESS OF DISPATCHER 28800017 SR R7,R7 SET TDIR SWITCH TO ZERO 29100017 ST R7,SHMPARM+4 INITIALIZE MSG SEARCH 29400017 L R3,SHMCARD ADDRESS OF CARD IMAGE 29700017 CLI 82(R3),0 CHECK FOR SPECIFIC TERMINAL 30000017 BE SHM10 BRANCH IF NOT SPECIFIED 30300017 SPACE 30600017 LA R1,82(R3) 30900017 L R15,SHMCBSTD 31200017 BALR R14,R15 SEARCH TDIR FOR TERMID 31500017 SPACE 31800017 LTR R15,R15 32100017 BNZ SHM49 BRANCH IF TERMID NOT FOUND 32400017 SPACE 32700017 LR R6,R1 SAVE ADDRESS OF TDIR ENTRY 33000017 B SHM20 33300017 SPACE 3 33600017 SHM10 L R4,SHMCDTLN 33900017 L R5,SHMCDTNB 34200017 LH R5,0(R5) NUMBER OF TDIR ENTRIES 34500017 LTR R5,R5 34800017 BZ SHM42 BRANCH IF NO ENTRIES 35100017 SPACE 35400017 MH R5,0(R4) LENGTH OF TDIR 35700017 LH R4,0(R4) LENGTH OF TDIR ENTRY 36000017 L R6,SHMCDTDR INITIALIZE TO BEGINNING OF TDIR 36300017 AR R5,R6 GET END OF TABLE 36600017 SH R5,=H'1' 36900017 SPACE 37200017 SHM15 SR R1,R1 37500017 ST R1,SHMPARM+4 RESET SEARCH STARTING POINT 37800017 LR R1,R6 38100017 SHM20 MVC SHMTERM,TDIRTERM 38400017 S R1,SHMCDTDR GET TDIR DISPLACEMENT 38700017 ST R1,SHMPARM+12 PUT IN PARAMETER LIST 39000017 OI SHMPARM+12,X'80' DO NO DELETE MSG 39300017 SR R8,R8 SET TERMINAL SWITCH TO ZERO 39600017 SPACE 39900017 SHM25 LA R1,SHMPARM-4 ADDRESS OF PARAMETER LIST 40200017 LR R15,R9 GET ADDRESS OF IHKCDMDQ 000B 40500017 BALR R14,R15 BRANCH TO ROUTINE 40800017 SPACE 41100017 CH R15,SHMFOUR CHECK FOR DISK ERROR 41400017 BNH SHM30 BRANCH IF NO DISK ERROR 41700017 STH R15,SHMOFSET PUT ERROR MSG OFFSET IN PARM 42000017 LA R1,SHMPARM1 42300017 B SHM65 42600017 SPACE 42900017 SHM30 EQU * 43200017 LTR R15,R15 CHECK RETURN CODE 43500017 BNZ SHM40 BRANCH IF NO MSG RETURNED 43800017 SPACE 44100017 ST R1,SHMPARM+4 SAVE MSG DIRECTORY POINTER 44400017 LA R7,1 TURN ON TDIR SWITCH 44700017 LTR R8,R8 CHECK TERMINAL SWITCH 45000017 BNZ SHM35 BRANCH IF ON 45300017 MVI SHMLNG,L'TDIRTERM LENGTH 45600017 BAL R11,SHM70 WRITE MSG 45900017 LA R8,1 TURN ON TERMINAL SWITCH 46200017 SPACE 3 46500017 SHM35 LA R1,SHMPARM3 ADDRESS OF PARAMETER LIST 46800017 L R15,SHMCBLDM ADDRESS OF BUILDMSG 47100017 BALR R14,R15 WRITE MSG 47400017 B SHM25 47700017 SPACE 48000017 *END OF LOOP THROUGH MSGS FOR ONE TERMINAL 48300017 SPACE 3 48600017 SHM40 CLI 82(R3),0 CHECK FOR SPECIFIC TERMINAL 48900017 BNZ SHM45 49200017 BXLE R6,R4,SHM15 GO TO NEXT TDIR ENTRY 49500017 SPACE 49800017 *END OF LOOP THROUGH TDIR 50100017 SPACE 3 50400017 LTR R7,R7 CHECK TDIR SWITCH 50700017 BNZ SHM50 BRANCH IF ON 51000017 SPACE 51300017 SHM42 MVC SHMTERM(L'SHMMSG1),SHMMSG1 51600017 MVI SHMLNG,L'SHMMSG1 LENGTH OF PARAMETERS 51900017 BAL R11,SHM70 WRITE MSG 52200017 B SHM50 52500017 SPACE 3 52800017 SHM45 LTR R8,R8 CHECK TERMID SWITCH 53100017 BNZ SHM50 BRANCH IF ON 53400017 SPACE 53700017 MVI SHMLNG,L'SHMMSG1+L'TDIRTERM 54000017 BAL R11,SHM70 54300017 B SHM50 54600017 SHM50 SR R15,R15 SET RETURN CODE TO ZERO 54900017 SHM52 EQU * 55200017 DELETE EP=IHKCDMDQ 55500017 L R13,SHMSAVE+4 55800017 RETURN (14,12),T,RC=(15) 56100017 SPACE 3 56400017 SHM49 EQU * 56700017 MVC SHMSEQ,72(R3) MOVE SEQUENCE NO. TO PARM LIST 57000017 LA R1,SHMPARM4 ADDRESS OF PARAMETER LIST 57300017 SHM65 EQU * 57600017 L R15,SHMCBLDM ADDRESS OF BUILDMSG 57900017 BALR R14,R15 WRITE MSG 58200017 LA R15,4 SET ERROR RETURN CODE 58500017 B SHM52 58800017 SPACE 59100017 SHM70 LA R1,SHMPARM2 ADDRESS OF PARAMETER LIST 59400017 L R15,SHMCBLDM ADDRESS OF BUILDMSG 59700017 BALR R14,R15 WRITE MSG 60000017 BR R11 RETURN 60300017 SPACE 3 60600017 *PARAMETER LIST FOR IHKCDMDQ 60900017 SPACE 61200017 DS F 61500017 SHMPARM DC X'80' 61800017 DC XL3'0' 62100017 DS F 62400017 DC A(SHMBFR) 62700017 DS F 63000017 SPACE 3 63300017 *PARAMETER LIST FOR BUILDMSG-DISK ERROR 63600017 SPACE 63900017 SHMPARM1 DC F'0' SEND MSG TO CENTRAL 64200017 SHMOFSET DC H'0' OFFSET 64500017 DC X'0' LENGTH OF PARAMETERS 64800017 SPACE 3 65100017 *PARAMETER LIST FOR BUILDMSG-HEADING FOR DELAYED MSGS 65400017 SPACE 65700017 SHMPARM2 DC F'0' SEND MSG TO CENTRAL 66000017 DC H'32' HEADING FOR TERMINAL 66300017 SHMLNG DS X 66600017 SHMTERM DS CL8 66900017 SHMMSG1 DC CL5' NONE' 67200017 SPACE 3 67500017 *PARAMETER LIST FOR BUILDMSG-DELAYED MSG 67800017 SPACE 68100017 SHMPARM3 DC F'0' SEND MSG TO CENTRAL 68400017 DC H'30' MSG 68700017 DC FL1'59' LENGTH OG MSG 69000017 SHMBFR DS CL60 69300017 SPACE 3 69600017 *PARAMETER LIST FOR BUILDMSG-INVALID TERMID 69900017 SPACE 70200017 SHMPARM4 DC F'0' SEND MSG TO CENTRAL 70500017 DC H'6' INVALID TERMID 70800017 DC FL1'16' LENGTH 71100017 DC CL8'SHOW' COMMAND 71400017 SHMSEQ DS CL8 SEQUENCE NUMBER 71700017 SPACE 3 72000017 SHMSAVE DS 18F 72300017 SHMFOUR DC H'4' 72600017 SPACE 3 72900017 TDIR DSECT 73200017 TDIRTERM DS CL8 73500017 SPACE 3 73800017 SHMLIST DSECT 74100017 DS F 74400017 SHMCARD DS F 74700017 SHMAADSP DS A 75000017 DS 2V 75300017 SHMCBLDM DS V 75600017 DS 2V 75900017 SHMCDMDQ DS V 76200017 DS V 76500017 SHMCBSTD DS V 76800017 DS 10V 77100017 SHMCDTDR DS V 77400017 SHMCDTLN DS V 77700017 SHMCDTNB DS V 78000017 DS F 78300017 SHMCDCBS DS F 78600017 END 78900017 ./ ADD SSI=03013100,NAME=IHKCASTP,SOURCE=0 STPP TITLE 'IHKCASTP/STOP RJE' 00400019 *0782111000,228000,231000,447000,501000, 000B 00800019 *0782282000,288000-294000,369000,378000,507000,510000,522000 000B 01200019 *0782531000-534000,576000,582000,615000,621000-624000 000B 01600019 *0782633000-639000,657000-846000,315000,651000 000B 02000019 * 100000,380000,384000,872000,884000,476000,564000,504000-508000 A24702 02200019 *********************************************************************** 02400019 * 02800019 *FUNCTION/OPERATION 03200019 * 03600019 * THIS ROUTINE SYNCHRONIZES THE CLOSING DOWN OF THE VARIOUS SUBTASKS 04000019 * OF THE RJE SYSTEM AND ACCOMPLISHES THE ROLLING OUT OF THE RJE 04400019 * TABLES TO DISK. THE FOLLOWING ACTIONS ARE TAKEN 04800019 * 1.THE RJE STOP BIT IN THE RJECOMM REGION IS SET. 05200019 * 2.A RESETPLMACRO IS ISSUED FOR EACH COMMUNICATIONS LINE. 05600019 * 3.THE FASTCNT IS INCREMENTED FOR EACH ENTRY IN THE FASTAB. 06000019 * 4.A WAIT IS MADE FOR EACH TERMINAL AND FOR SYSDEQ. 06400019 * 5.A NORMAL CLOSEDOWN IS INDICATED IN THE FASTABLE. 06800019 * 6.TDIRFAST IS CHECKED FOR ANY LEFTOVER DISCONTINUED QEBS. THE OVER- 07200019 * LOAD SAFETY ROUTINE IS LOADED TO PROCESS THE QEB. 07600019 * 6.ALL DATA SETS ARE CLOSED. 08000019 * 08400019 *ENTRY POINT 08800019 * IHKCASTP 09200019 * 09600019 * REGISTER 1 CONTAINS THE ADDRESS OF A PARAMETER LIST: A24702 09700019 * WORD 1 - AVT ADDRESS A24702 09800019 * WORD 2 - ADDRESS OF FIRST LCB A24702 09900019 * WORD 3 - ADDRESS OF HALFWORD CONTAINING NO. OF LINES A24702 10000019 * WORD 4 - ADDRESS OF HALFWORD CONTAINING LENGTH OF ENTRY A24702 10100019 * 10400019 *INPUT-N/A 10800019 * 11200019 *OUTPUT-N/A. 11600019 * 12000019 *EXTERNAL ROUTINES 12400019 * 12800019 * IHKAADSP-DISPATCHER.WAITS FOR ECBS 13200019 * IHKCDFMR-TABLE MANAGERS.WRITES TABLE ENTRIES TO DISK. 13600019 * IHKCCQMG-QUEUE MANAGER.DOES RESETPL 14000019 * IHKCDCMR-CLOSE MANAGER.CLOSES DATA SETS. 14400019 * IHKCAOSR-OVERLOAD SAFETY RTN-PROCESSES DISCONTINUED QEBS. 14800019 * 15200019 *EXITS-NORMAL 15600019 * 16000019 * THIS ROUTINE RETURNS CONTROL TO IHKBBCCR WHEN SUBTASK CLOSEDOWN000B 16400019 * IS COMPLETE. 000B 16800019 * 17200019 *EXITS-ERROR-N/A. 17600019 * 18000019 *ATTRIBUTES 18400019 * 18800019 * SERIALLY REUSABLE. 19200019 * 19600019 *********************************************************************** 20000019 SPACE 3 20400019 IHKCASTP CSECT 20800019 SPACE 21200019 R0 EQU 0 21600019 R1 EQU 1 PARAMETERS 22000019 R2 EQU 2 ADDRESS OF LIST OF ADDRESS 22400019 R3 EQU 3 22800019 R4 EQU 4 LENGTH OF TDIR ENTRY 23200019 R5 EQU 5 LENGTH OF TDIR 23600019 LCB EQU 3 LCB POINTER A24702 23700019 NOL EQU 4 NUMBER OF LINES A24702 23800019 LGL EQU 5 LENGTH OF LCB ENTRY A24702 23900019 R6 EQU 6 ADDRESS OF TDIR ENTRY 24000019 R7 EQU 7 24400019 R8 EQU 8 24800019 R9 EQU 9 25200019 R10 EQU 10 25600019 R11 EQU 11 26000019 R12 EQU 12 BASE 26400019 R13 EQU 13 SAVE AREA 26800019 R14 EQU 14 RETURN 27200019 R15 EQU 15 ENTRY 27600019 SPACE 28000019 STPRJE EQU B'10000000' STOP RJE SWITCH 28400019 STPRJEND EQU B'00010000' PROCESSED RJEND SWITCH 28800019 STPRJSRT EQU B'00010000' RJSTART SWITCH 29200019 STPPOST EQU X'40' POST ECB 29600019 STPSYSDQ EQU X'10' SYSDEQ'S BUSY BIT 30000019 STPINACT EQU C' ' INACTIVE FASTAB ENTRY 30400019 STPUNUSE EQU 0 UNUSED FASTAB ENTRY 30800019 SPACE 3 31200019 B 12(R15) BRANCH AROUND IDENTIFIER 000B 31600019 DC C'IHKCASTP' 000B 32000019 STM R14,R12,12(R13) 32400019 BALR R12,0 32800019 USING *,R12 33200019 ST R13,STPSAVE+4 33600019 LA R11,STPSAVE 34000019 ST R11,8(R13) 34400019 LR R13,R11 34800019 SPACE 35200019 *END OF STANDARD LINKAGE 35600019 SPACE 3 36000019 USING IHKZZAVT,R2 000B 36400019 USING TDIREC,R6 36800019 USING FASTAB,R7 37200019 SPACE 37600019 L R2,0(R1) GET ADDRESS OF AVT A24702 38200019 L R9,IHKZZRCS ADDRESS OF SWITCHES 000B 38800019 OI 0(R9),STPRJE TURN ON STOP RJE SWITCH 39200019 USING LCBDSECT,LCB SET UP LCB ADDRESSABILITY A24702 39230019 LM LCB,LGL,4(R1) GET READY TO LOOP LCBS A24702 39260019 LH NOL,0(NOL) GET NUMBER OF LINES A24702 39290019 STPLLOOP MVC STPDECB,LCBLDECB PUT DECB ADDRESS IN LIST A24702 39320019 LA R1,STPZERO ADDRESS OF PARAMETERS A24702 39350019 L R15,IHKZZQMG ADDRESS OF IHKCCQMG A24702 39380019 BALR R14,R15 GO RESETPL A24702 39410019 AH LCB,0(LGL) STEP TO NEXT LCB A24702 39440019 BCT NOL,STPLLOOP LOOP THROUGH LCBS A24702 39470019 SR R3,R3 INITIALIZE LOAD SWITCH A24702 39500019 L R4,IHKZZTLN 000B 39600019 L R5,IHKZZTNB 000B 40000019 L R6,IHKZZTDR 000B 40400019 LH R5,0(R5) 40800019 LTR R5,R5 CHECK FOR NO ENTRIES 41200019 BZ STP40 BRANCH IF NONE 41600019 SPACE 42000019 MH R5,0(R4) LENGTH OF TABLE 42400019 AR R5,R6 GET END OF TDIR 42800019 BCTR R5,R0 SUBSTRACT ONE 000B 43200019 LH R4,0(R4) LENGTH OF TDIR ENTRY 43600019 SPACE 3 44000019 *CHECK FOR ACTIVE TERMINALS THEN RESETPL AND GO TO DISPATCHER TO WAIT 44400019 *FOR LINE SCHEDULER TO POST THE STOP ACK ECB. 44800019 SPACE 45200019 STP32 EQU * 45600019 LR R1,R2 ADDRESS OF IHKCACOM 46000019 ST R6,0(R2) PUT TDIR ENTRY IN PARM LIST 46400019 TM TDIRSTAT,STPRJEND CHECK FOR PROCESSED RJEND 46800019 BNZ STP35 BRANCH IF RJEND NOT PROCESSED 47200019 CLC STPZERO(3),TDIRFQEB+1 CHECK FOR EMPTY QUEUE A24702 47600019 BNZ STP35 BRANCH IF NOT EMPTY 48000019 TM TDIRSWCH,STPRJSRT CHECK FOR RJSTART 48400019 BO STP35 BRANCH IF RJSTART RECEIVED 48800019 OI TDIRSECB,STPPOST POST STOP ACK ECB FOR LINE 49200019 B STP37 SLIP RESETPL AND DISPATCHER 49600019 STP35 EQU * 50000019 LA R1,TDIRSECB ADDRESS OF TERMINAL STOP ECB 51200019 L R15,IHKZZDSP 000B 51600019 BALR R14,R15 GO TO DISPATCHER TO WAIT 52000019 STP37 EQU * 52400019 SPACE 3 52800019 *CHECK FOR ANY DISCONTINUED OUTPUT. IF THERE IS ANY, RE-ENQUEUE IT AND 53200019 *GO TO OVERLOAD ROUTINE TO CLEAR THE QUEUE AND PROCESS THE QEB. AT THIS 53600019 *POINT IN TIME THERE IS NO CHANCE THAT THE OUTPUT WILL BE SENT TO THE 54000019 *TERMINAL. THE CONTINUE FUNCTION IS NOT SUPPORTED OVER A CENTRAL CLOSE- 54400019 *DOWN. WHEN RJE STARTS UP, ANY DISCONTINUED JOBS ARE RETRANSMITTED 54800019 *STARTING AT THE BEGINNING. THE DISCONTINUE SWITCHES ARE NOT TURNED OFF 55200019 *BECAUSE THEY ARE INITIALIZED AT STARTUP TIME. 55600019 SPACE 56000019 CLC STPZERO(3),TDIRFAST+1 CHECK FOR DISC. QEB A24702 56400019 BE STP39 BRANCH IF NO DISCONTINUED QEB 56800019 SPACE 57200019 L R15,TDIRFAST 57600019 ST R15,TDIRFQEB 58000019 ST R15,TDIRLMEL 58400019 ST R15,TDIRLQEB 58800019 XC 1(3,R15),1(R15) CLEAR LINK FIELD OF QEB 59200019 LTR R3,R3 CHECK LOADED SWITCH 59600019 BNZ STP38 BRANCH IF RTN ALREADY LOADED 60000019 SPACE 60400019 LOAD EPLOC=STPCAOSR BRING IN OVERLOAD WITH 000B 60800019 * - SUPER ASSIST 000B 61200019 LA R3,1 TURN ON LOADED SWITCH 61600019 SPACE 62000019 STP38 EQU * 62400019 LR R15,R0 LOAD ENTRY POINT 62800019 LR R1,R2 ADDRESS OF PARAMETER LIST 63200019 BALR R14,R15 BRANCH TO OVERLOAD RTN 63600019 SPACE 64000019 STP39 EQU * 64400019 BXLE R6,R4,STP32 LOOP THROUGH TDIR 64800019 SPACE 65200019 *END OF LOOP THROUGH TDIR 65600019 SPACE 3 66000019 *CHECK LOADED SWITCH TO SEE IF ROUTINE SHOULD BE DELETED. 66400019 SPACE 66800019 LTR R3,R3 CHECK SWITCH 67200019 BZ STP40 BRANCH IF OVERLOAD RTN NOT IN 67600019 SPACE 68000019 DELETE EPLOC=STPCAOSR REDUCE OVERLOAD USE COUNT 000B*68400019 - BY A FACTOR OF ONE 000B 68800019 SPACE 69200019 STP40 L R1,IHKZZSAI ADDRESS OF SYSDEQ STOP ACK 000B 69600019 TM 0(R9),STPSYSDQ CHECK TO SEE IF SYSDEQ THROUGH 70000019 BO STP42 BRANCH IF NOT THROUGH 70400019 L R9,IHKZZSQE GET ADDR OD SDQ QMGR ECB 000B 70800019 OI 0(R9),STPPOST POST SDQ ECB 000B 71200019 STP42 EQU * 71600019 L R15,IHKZZDSP 000B 72000019 BALR R14,R15 GO TO DISPATCHER TO WAIT 72400019 STP15 SR R9,R9 72800019 L R7,IHKZZFTB BEGINNING OF FASTAB 000B 73200019 L R8,IHKZZFES END OF FASTAB 000B 73600019 SPACE 3 74000019 *BEGINNING OF LOOP THROUGH FASTAB TO INCREMENT FASTCNT 74400019 SPACE 74800019 STP20 C R7,0(R8) CHECK FOR END OF TABLE 75200019 BNL STP43 BRANCH IF END 75600019 CLI FASTNAME,STPINACT CHECK FOR ACTIVE ENTRY 76000019 BE STP25 BRANCH IF INACTIVE 76400019 CLI FASTNAME,STPUNUSE CHECK FOR DISABLED ENTRY 76800019 BE STP25 BRANCH IF DISABLED 77200019 IC R9,FASTCNT 77600019 LA R9,1(R9) INCREMENT FASTCNT 78000019 STC R9,FASTCNT 78400019 LA R1,FASTNAME ADDRESS OF ENTRY 78800019 L R15,IHKZZFMR 000B 79200019 BALR R14,R15 WRITE FASTAB ENTRY 000B 79600019 STP25 L R10,IHKZZFLN 000B 80000019 AH R7,0(R10) 80400019 B STP20 80800019 SPACE 81200019 *END OF LOOOP THROUGH FASTAB 81600019 SPACE 3 82000019 *INDICATE NORMAL CLOSEDOWN AND RETURN TO IHKBBCCR 000B 82400019 SPACE 82800019 STP43 EQU * 83200019 L R1,0(R8) ADDRESS OF LAST FASTAB ENTRY 83600019 MVI 1(R1),X'FF' INDICATE NORMAL CLOSEDOWN 84000019 L R15,IHKZZFMR ADDRESS OF FASTAB MANAGER 000B 84400019 BALR R14,R15 WRITE FASTAB ENTRY 84800019 SPACE 3 85200019 L R13,STPSAVE+4 85600019 RETURN (14,12),T GO ON BACK BABY 000B 86000019 SPACE 3 86400019 STPSAVE DS 18F 86800019 STPZERO DC F'0' 2-WORD LIST FOR RESETPL A24702 87000019 STPDECB DC A(0) DECB ADDRESS A24702 87200019 STPCAOSR DC CL8'IHKCAOSR' OVERLOAD MODULE NAME 000B 87600019 SPACE 3 88000019 IHKDSECT TDIR,,FASTAB,,LCB,AVT A24702 88400019 END 88800019 ./ ADD SSI=01012512,NAME=IHKCBCLD,SOURCE=0 COLD TITLE 'IHKCBCLD - RJE COLD START MODULE' 00900017 IHKCBCLD CSECT 01800017 *3320252000,279000,288000,549000,783000,801000-819000,837000-855000000B 02700017 *********************************************************************** 03600017 * * 04500017 *STATUS- * 05400017 * CHANGE LEVEL 0 * 06300017 * * 07200017 *FUNCTION/OPERATION- * 08100017 * THIS ROUTINE IS LINKED TO BY RJENIP IF 'FORM' WAS SPECIFIED ON * 09000017 * THE 'START RJE' STATEMENT. RJE COLDSTART FREES ALL OF THE FAST * 09900017 * TABLE ENTRIES. THIS IS ACCOMPLISHED BY INSERTING A X'40' IN THE * 10800017 * FIRST BYTE OF THE FASTNAME FIELD OF EACH ENTRY AND THEN WRITING * 11700017 * EACH ENTRY TO DISK. * 12600017 * * 13500017 *ENTRY POINTS- * 14400017 * IHKCBCLD IS THE ONLY ENTRY POINT. * 15300017 * * 16200017 *INPUT- * 17100017 * REGISTER ONE POINTS TO THE COMMAND INTERRETER'S LIST OF ADDRESSES.* 18000017 * RJE COLDSTART USES, FROM THIS LIST, THE ADDRESSES OF IHKCDFNB, * 18900017 * IHKCDFLN, IHKCDFTB, AND IHKCBLDN. * 19800017 * * 20700017 *OUTPUT- * 21600017 * THE FAST TABLE ENTRIES REFLECT NO JOBS IN THE RJE SYSTEM. * 22500017 * * 23400017 *EXTERNAL ROUTINES- * 24300017 * BSAM - OPEN, WRITE, CHECK, AND CLOSE MACROS ARE USED. * 25200017 *EXITS-NORMAL- * 26100017 * RETURN WITH ZERO RETURN CODE 000B 27000017 * * 27900017 *EXITS-ERROR- * 28800017 * RETURN WITH FOUR RETURN CODE 000B 29700017 * * 30600017 *TABLES/WORK AREAS- * 31500017 * AN 18 WORD SAVE AREA IS PROVIDED. A 22 WORD BSAM DCB IS USED TO * 32400017 * WRITE TO DISK. * 33300017 * * 34200017 *ATTRIBUTES- * 35100017 * THIS ROUTINE IS NON-RESIDENT AND SERIALLY RE-USABLE. * 36000017 * * 36900017 *NOTES- * 37800017 * THIS ROUTINE IS NOT DEPENDENT UPON THE EXTERNAL CHARACTER SET USED* 38700017 * * 39600017 R0 EQU 0 40500017 R1 EQU 1 41400017 CBASE EQU 2 BASE FOR RJECOMM DSECT 42300017 R3 EQU 3 WORK REGISTER 43200017 FLN EQU 4 LENGTH OF FAST TABLE ENTRY 44100017 FNB EQU 5 NUMBER OF FAST TABLE ENTRIES 45000017 FTB EQU 6 ADDRESS OF FAST TABLE ENTRY 45900017 R7 EQU 7 RETURN ADDRESS FROM WRITE 46800017 R10 EQU 10 47700017 R12 EQU 12 BASE 48600017 R13 EQU 13 SAVE AREA POINTER 49500017 R14 EQU 14 RETURN ADDRESS 50400017 R15 EQU 15 ENTRY ADDRESS 51300017 STM R14,R12,12(R13) SAVE REGISTERS 52200017 BALR R12,R0 SET UP ADDRESSABILITY 53100017 USING *,R12 54000017 B COLD00 54900017 DC C'IHKCBCLD' 000B 55800017 COLD00 DS 0H 56700017 LA R10,SAVE SET UP SAVE AREA CHAINING 57600017 ST R10,8(R13) 58500017 ST R13,4(R10) 59400017 LR R13,R10 60300017 LR CBASE,R1 ADDRESS OF INTERFACE ADCONS 61200017 USING RJECOMM,CBASE 62100017 L R3,COMMFLN 63000017 LH FLN,0(R3) LENGTH OF FASTAB ENTRIES 63900017 L R3,COMMFNB 64800017 LH FNB,0(R3) NUMBER OF FAST TABLE ENTRTIES 65700017 LA FNB,1(FNB) 66600017 USING FASTAB,FTB 67500017 L FTB,COMMFTB ADDRESS OF FAST TABLE 68400017 LA R3,FASTDCB 69300017 USING IHADCB,R3 70200017 STH FLN,DCBLRECL FILL LOGICAL RECORD SIZE AND BLOCK 71100017 STH FLN,DCBBLKSI SIZE IN DCB 72000017 OPEN (FASTDCB,(OUTPUT)) 72900017 COLD01 MVI FASTNAME,X'40' FREE FAST TABLE ENTRY 73800017 COLD02 WRITE FASTDECB,SF,FASTDCB,(FTB) 74700017 CHECK FASTDECB WAIT FOR WRITE TO COMPLETE 75600017 AR FTB,FLN INCREMENT TO NEXT ENTRY 76500017 BCT FNB,COLD01 IF NOT END OF TABLE, FREE NEXT ENTRY 77400017 CLOSE FASTDCB 78300017 XR R15,R15 000B 79200017 EXIT L R13,SAVE+4 RETURN TO IHKCBNIP FOR FURTHER 80100017 RETURN (14,12),T,RC=(15) INITIALIZATION 000B 81000017 SYNAD LA R15,ISA4 000B 81900017 ISA4 EQU 4 000B 82800017 B EXIT 000B 83700017 SAVE DC 18F'0' SAVE AREA 84600017 FASTDCB DCB DSORG=PS,MACRF=WL,DDNAME=IHKFSTDD,RECFM=F,BUFNO=1, X85500017 SYNAD=SYNAD 86400017 DCBD DSORG=PS 87300017 RJECOMM DSECT 88200017 DS 18F 89100017 COMMFTB DS F ADDRESS OF FAST TABLE 90000017 COMMFLN DS F ADDRESS OF LENGTH INDICATOR 90900017 COMMFNB DS F ADDRESS OF COUNT OF FASTAB ENTRIES 91800017 FASTAB DSECT 92700017 FASTNAME DS CL8 JOB NAME 93600017 END 94500017 ./ ADD SSI=02012961,NAME=IHKCBLGN,SOURCE=0 LGN TITLE 'LOGON' 00200017 IHKCBLGN CSECT 00400017 *3350144000-150000,309000,480000,600000,630000,756000,783000, 000A 00600017 *3350789000,825000,837000,861000-864000 000A 00800017 *0788420000-424000,540000-544000 000B 01000017 *0788014000 000B 01200017 *2513462000-464000,468000 000C 01300000 *C025000-040000,048000,070000,080000,164000 A43081 01330021 *D032000-044000,162000,166000 A43081 01360021 *********************************************************************** 01400017 *STATUS: CHANGE LEVEL 3,RELEASE 21 01700021 *FUNCTION/OPERATION: * 02000017 * THIS ROUTINE PROCESSES THE LOGON STATEMENT. IT IS A43081 02500021 * ENTERED FROM THE COMMAND INTERPRETER IF CONTROL WAS A43081 03000021 * TRANSFERRED TO THE COMMAND INTERPRETER FROM THE RJE READER. A43081 03500021 * THE BASIC FUNCTIONS OF THE LOGON COMMAND PROCESSOR ARE: A43081 04000021 * * 04600017 * (1) LOG USER ON THE RJE SYSTEM A43081 04800021 * FOR ANY CASE IN WHICH THE LOGON IS REJECTED, AN APPROPRIATE * 05000017 * DIAGNOSTIC MESSAGE IS RETURNED. * 05200017 * IF THE LOGON STATEMENT IS VALID, THE LOG ON PROCEDURE IS * 05400017 * EXECUTED. THIS CONSISTS OF : * 05600017 * (A) ENTERING THE USER ID IN THE 'CURRENT LOG ON' PORTION OF * 05800017 * THE TERMINAL DIRECTORY ENTRY CORRESPONDING TO THIS USER'S TERMINAL* 06000017 * (B) ENTERING THE TERMINAL ID IN THE USER DIRECTORY ENTRY FOR * 06200017 * THIS USER, AND * 06400017 * (C) TRANSMIT A ' LOGON ACCEPTED' MESSAGE * 06600017 * * 06800017 * (2) NOTIFY USER OF ANY PENDING DEFERRED OUTPUT A43081 07000021 * IF THERE ARE ANY NOTIFIES PENDING, THE USER IS NOTIFIED AND * 07200017 * THE NOTIFY PENDING LOG ON AND THE NOTIFY PENDING TERMINAL STARTUP * 07400017 * BITS IN THE USER DIRECTORY ARE TURNED OFF. * 07600017 * * 07800017 * (3) SEND USER ANY BYPASSED OUTPUT A43081 08000021 * IF THE USER HAS ANY BYPASSED OUTPUT, HE IS SENT * 08200017 * THIS AT THE NEXT RJSTART FROM THIS TERMINAL. HOWEVER, IF HE * 08400017 * HAS CHANGED TERMINALS BEFORE ANOTHER RJSTART IS RECIEVED FROM HIS * 08600017 * OLD TERMINAL, THE 'BYPASSED OUTPUT' IS GIVEN * 08800017 * WHEN HE LOGS ON AND THE BIT TURNED OFF IN THE USER DIRECTORY * 09000017 * ENTRY. * 09200017 * * 09400017 *ENTRY POINTS: * 09600017 * IHKCBLGN IS THE ONLY ENTRY POINT. * 09800017 * IHKCBLGN -VALIDATE A LOGON REQUEST AND LOG USER ON SYSTEM IF * 10000017 * LOGON VALID. * 10200017 * LA 1,ADDRESS VECTOR TABLE 000A 10400017 * CALL IHKCBLGN 000A 10600017 *INPUT: * 10800017 * STANDARD SUBROUTINE LINKAGE PREVAILS. REGISTER ONE POINTS TO THE * 11000017 * ADDRESS VECTOR TABLE (AVT) WHOSE DESCRIPTION APPEARS BEFORE THE000A 11200017 * EXPANSION OF THE DSECT IHKZZAVT. 000A 11400017 * * 11600017 * * 12200017 *OUTPUT: * 12400017 * NO OUTPUT EXCEPT THAT LISTED UNDER 'EXITS'. * 12600017 * * 12800017 *EXTERNAL ROUTINES: * 13000017 * IHKCCSUD- SEARCH USER DIRECTORY FOR USER'S ENTRY * 13200017 * IHKCCSGN- SEARCH FAST TABLE FOR NOTIFIES PENDING LOGON AND * 13400017 * BYPASSED OUTPUT * 13600017 * IHKCFQOP- SENDS BYPASSED OUTPUT TO USER * 13800017 * IHKCBLDM- ENQUEUE SYSTEM MESSAGES. * 14000017 * IHKCDFMR- WRITE UPDATED FAST TABLE TO DISK * 14200017 * IHKCDUMR- WRITE UPDATED USER DIRECTORY ENTRY TO DISK * 14400017 * IHKCDTMR- WRITE UPDATED TERMINAL DIRECTORY ENTRY TO DISK * 14600017 * IHKCDJMR- READ JED TABLE ENTRY * 14800017 * * 15000017 *EXITS-NORMAL: * 15200017 * REGISTER FIFTEEN WILL HAVE A RETURN CODE OF ZERO. ALL * 15400017 * OTHER REGISTERS REMAIN TRANSPARENT. * 15600017 * 15800017 *EXITS-ERROR: 16100021 * NONE A43081 16400021 * * 16800017 *TABLES/WORK AREAS: * 17000017 * IHKCDFTB * 17200017 * FAST TABLE- LIST OF ACTIVE JOBS WITHIN RJE SYSTEM AND ASSOCIATED * 17400017 * DATA. * 17600017 * IHKCDUDR * 17800017 * USER DIRECTORY-LIST OF AUTHORIZED USERS OF THE RJE SYSTEM AND * 18000017 * ASSOCIATED DATA. * 18200017 * IHKCDTDR * 18400017 * TERMINAL DIRECTORY- LIST OF POTENTIAL REMOTE TERMINALS AVAILABLE * 18600017 * TO THE RJE SYSTEM AND ASSOCIATED TERMINAL DATA. * 18800017 * JED TABLE- LOGICAL EXTENSION OF FAST TABLE WITH ADDITIONAL * 19000017 * INFORMATION CONCERNING ACTIVE JOBS WITHIN RJE SYSTEM. * 19200017 * * 19400017 * FOR A DETAILED LAYOUT OF THESE TABLES SEE THE DSECTS AT THE END * 19600017 * OF THE CODING * 19800017 * * 20000017 *ATTRIBUTES: * 20200017 * SERIALLY REUSABLE, NON-RESIDENT 000A 20400017 * * 20600017 *NOTES: * 20800017 * N/A * 21000017 * * 21200017 *********************************************************************** 21400017 * 21600017 * GENERAL REGISTERS AND USEAGE 21800017 * 22000017 R0 EQU 0 PASSING PARAMETERS 22200017 R1 EQU 1 PASSING PARAMETERS 22400017 R2 EQU 2 BASE REGISTER FOR ENTRY IN TERMINAL 22600017 R3 EQU 3 ADDRESS OF INPUT PARAMETERS 22800017 R4 EQU 4 BASE REGISTER FOR ENTRY IN USER 23000017 * DIRECTORY 23200017 R5 EQU 5 PARAMETER MANIPULATION FOR 23400017 * BUILDMSG 23600017 R7 EQU 7 ADDRESS OF FAST TABLE ENTRY * 23800017 R8 EQU 8 RETURN REGISTER FROM BRANCHING TO * 24000017 * CALLS 24200017 R9 EQU 9 ADDRESS OF PARAMETER LIST 24400017 R10 EQU 10 ADDRESS OF MY SAVE AREA 24600017 VCONBASE EQU 11 000A 24800017 R12 EQU 12 BASE REGISTER FOR LOGON ROUTINE 25000017 R13 EQU 13 ADDRESS OF MY SAVE AREA 25200017 R14 EQU 14 RETURN ADDRESSES 25400017 R15 EQU 15 ENTRY ADDRESSES, RETURN CODES 25600017 * *********** 25800017 * 26000017 * SAVE REGISTERS AND ESTABLISH ADDRESSABILITY 26200017 * 26400017 * *********** 26600017 STM 14,12,12(13) SAVE REGISTERS 26800017 BALR R12,R0 SET UP ADDRESSABILITY 27000017 USING *,R12 27200017 B A 27400017 DC C'IHKCBLGN' 000B 27600017 A DS 0H 27800017 USING IHKZZAVT,VCONBASE 000A 28000017 LR VCONBASE,R1 000A 28200017 LA R10,SAVE PROVIDE FOR TRACING REGISTERS 28400017 ST R10,8(R13) 28600017 ST R13,4(R10) 28800017 LR R13,R10 PROVIDE ADDRESS OF MY SAVE AREA 29000017 * *********** 29200017 * 29400017 * 29600017 * *********** 29800017 LR R9,R1 SAVE ADDRESS OF PARAMETER LIST 30000017 L R2,0(R1) LOAD POINTER OT TERMINAL DIRECTORY 30200017 * ENTRY 30400017 USING TDIREC,R2 DIRECTORY DSECT. 30600017 L R3,4(R1) SAVE POINTER TO INPUT PARAMETER LIST 30800017 MVC PARMSN1(3),81(R3) MOVE USER ID INTO STORAGE AREA 31000017 L R1,PARMSN1 GET USER IDENTIFICATION 31200017 L R15,IHKZZSUD 000A 31400017 BALR R14,R15 000A 31600017 LR R4,R1 SAVE ADDRESS OF USER ENTRY IN USER 31800017 USING UDIREC,R4 32000017 * *********** 32200017 * 32400017 * LOG USER ON SYSTEM 32600017 * 32800017 * *********** 33000017 MVC TDIRUSID(3),81(R3) MOVE USER ID INTO TERMINAL DIRECTORY 33200017 * ENTRY 33400017 * *********** 33600017 * 33800017 * CHECK FOR ANY NOTIFIES PENDING THIS LOGON 34000017 * 34200017 * *********** 34400017 TM UDIRSTAT,24 TEST NOTIFY PENDING LOGON INDICATOR 34600017 * BIT IN STATUS BYTE OF USER DIRECTORY 34800017 BZ UNDLVOUT IF NO NOTIFIES PENDING, GO TO 35000017 * BYPASSED OUTPUT CHECK 35200017 SR R1,R1 35400017 ST R1,PARMSN1 FILL IN PARAMETERS FOR SRCHGEN 35600017 SRCHFAST ST R1,PARMSN2 35800017 MVI PARMS4,C'L' 36000017 BAL R8,SEARCH SEARCH FAST TABLE FOR NOTIFIES 36200017 LTR R15,R15 36400017 BNE NOTFYEND IF ENTRY NOT FOUND - END OF TABLE 36600017 LR R7,R1 SAVE ADDRESS OF FAST TABLE 36800017 USING FASTAB,R7 37000017 TM FASTDSB,16 DID JOB END NORMALLY 37200017 BO ABNORM IF NOT SET OFFSET 'ABEND NOTIFY' 37400017 LA R5,31 MESSAGE OFFSET 37600017 NTFYPARM MVC PARMS3+9(3),81(R3) USER ID 37800017 MVC PARMS3(8),0(R7) JOB NAME 38000017 MVI PARMS3+8,C' ' 38200017 TM FASTJIB,8 38400017 BZ NOINFO 38600017 LA R0,PARMS3+13 SAVE ADDRESS OF JED TABLE ENTRY 38800017 ST R7,PARAMLST 000A 39000017 ST R0,PARAMLST+4 000A 39200017 LA R1,PARAMLST 000A 39400017 L R15,IHKZZJMR 000A 39600017 BALR R14,R15 000A 39800017 MVI PARMS3+12,C' ' 40000017 MVI BLDCLENT,38 MESSAGE PARM LENGTH 40200017 GONOTIFY BAL R8,BUILDMSG 40400017 CLC UDIRUSID(3),FASTUSE SOURCE OR ALTERNATE NOTIFICATION 40600017 BE SOURCE IF SOURCE TURN OFFNOTIFY PENDING 40800017 * RJSTART AND TURN ON SOURCE NOTIFIED 41000017 NI FASTDSB,254 TURN OFF NOTIFY PENDING LOGON 41200017 OI FASTDSB,4 TURN ON ALTERNATE NOTIFIED 41400017 FMR DS 0H 000B 41600017 ST R7,PARMSN1 ADDRESS OF FAST TABLE ENTRY 41800017 SR R1,R1 42000017 B SRCHFAST GO TO SEARCH 42200017 NOINFO MVI BLDCLENT,12 42400017 B GONOTIFY 42600017 SOURCE NI FASTDSB,253 TURN OFF NOTIFY PENDING RJSTART 42800017 OI FASTDSB,8 TURN ON NOTIFY SOURCE 43000017 B FMR 43200017 ABNORM LA R5,38 MESSAGE OFFSET 43400017 B NTFYPARM 43600017 NOTFYEND NI UDIRSTAT,231 TURN OFF NOTIFY PENDING LOGON 43800017 * AND NOTIFY PENDING TERMINAL STARTUP 44000017 * INDICATOR IN USER DIRECTORY 44200017 * *********** 44400017 * 44600017 * CHECK FOR BYPASSED OUTPUT FOR USER LOGGING ON 44800017 * 45000017 * *********** 45200017 UNDLVOUT TM UDIRSTAT,128 TEST UNDELIVERED IMMEDIATE OUTPUT 45400017 * IDICATOR BIT IN STATUS BIT OF USER 45600017 * DIRECTORY ENTRY 45800017 BZ VLDLOGON IF NONE, GO TO END UP ROUTINE 46000017 SR R7,R7 SET UP PARAMETER LIST BEFORE GOI000C 46200000 ST R7,PARMSN2 000C 46400000 MVI PARMS4,C'I' 46600000 MOREUIO ST R7,PARMSN1 TO GENERAL SEARCH OF FAST TABLE 000C 46800000 BAL R8,SEARCH SEARCH FAST TABLE FOR OUTPUT 47000017 LTR R15,R15 47200017 BNE TURNOFF 47400017 LR R7,R1 47600017 ST R7,PARMSN1 47800017 TM FASTDSBE,128 ALTERNATE OR SOURCE BYPASSED OUTPUT 48000017 BZ ALT IF ALTERNATE, TURN OFF BYPASSED 48200017 * OUTPUT FOR ALTERNATE 48400017 NI FASTDSBE,127 TURN OFF BYPASSED OUTPUT SOURCE 48600017 B OUTPUT 48800017 ALT NI FASTDSBE,191 TURN OFF BYPASSED OUTPUT ALTERNATE 49000017 MVI PARMSN1,X'80' 49200017 OUTPUT L R1,PARMSN1 49400017 ST R2,PARAMLST 000A 49600017 ST R1,PARAMLST+4 000A 49800017 ST VCONBASE,PARAMLST+8 000A 50000017 LOAD EPLOC=LGNADQOP 000A 50200017 LR R15,R0 000A 50400017 LA R1,PARAMLST 000A 50600017 BALR R14,R15 000A 50800017 DELETE EPLOC=LGNADQOP 000A 51000017 B MOREUIO 51200017 TURNOFF NI UDIRSTAT,127 TURN OFF BYPASSED 51400017 * OUTPUT INDICATOR IN USER DIRECTORY 51600017 * ENTRY 51800017 * *********** 52000017 * 52200017 * SET PARAMETERS FOR GOING TO BUILDMSG ROUTINE WHICH PRINTS OUT 52400017 * ALL SYSTEM MESSAGES. IF LOGON IS TERMINATED, RETURN CODE IS SUPPLIED. 52600017 * 52800017 * *********** 53000017 VLDLOGON DS 0H 000B 53200017 CLC UDIRTERM(8),TDIRTERM THIS USERS LAST WORK STATION 000B 53400017 BE TAG YES NO NEED TO WRITE UDIR 000B 53600017 MVC UDIRTERM(8),TDIRTERM PLACE NEW TERMID IN UDIR 000B 53800017 LR R1,R4 ADDRESS OF USER DIRECTORY ENTRY. 54000017 L R15,IHKZZUMR 000A 54200017 BALR R14,R15 000A 54400017 TAG DS 0H 000B 54600017 LA R5,3 54800017 SPACE 55000017 MVC PARMS3(15),ULO PLACE USER LOGGED ON IN MSG 000B 55200017 MVC PARMS3+15(3),81(R3) USER ID 000B 55400017 MVC PARMS3+18(9),71(R3) CARD COLUMNS 72-80 000B 55600017 MVI BLDCLENT,27 TEXT LENGTH 000B 55800017 BAL R8,BUILDMSG 56000017 LOGDONE SR R15,R15 SET RETURN CODE 56200017 RETURN L R13,SAVE+4 56400017 RETURN (14,12),T,RC=(15) RETURN TO CALLING ROUTINE 56600017 BUILDMSG STH R5,PARMSN2 MESSAGE OFFSET 56800017 ST R2,PARMSN1 TERMINAL ENTRY ADDRESS 57000017 BADLOGON LA R1,PARMSN1 ADDRESS OF PARAMETER LIST 57200017 L R15,IHKZZLDM 000A 57400017 BALR R14,R15 000A 57600017 BR R8 57800017 SEARCH MVC PARMS3(3),81(R3) USER ID 58000017 LA R1,PARMSN1 LOAD PARAMETER REGISTER 58200017 L R15,IHKZZSGN 000A 58400017 BALR R14,R15 000A 58600017 BR R8 58800017 * *********** 59000017 * 59200017 * CONSTANTS 59400017 * 59600017 * *********** 59800017 LGNADQOP DC C'IHKCFQOP' 000A 60000017 PARAMLST DS 3F 000A 60200017 SAVE DS 18F SAVE AREA 60400017 PARMSN1 DS F PARAMETER LOCATION FOR LISTS GOING 60600017 PARMSN2 DS H TO SRCHGEN AND TO NOTIFY 1 60800017 BLDCLENT DS C SN INDICATES LABEL IS USED FOR BOTH 61000017 PARMS3 DS C S INDICATES LABEL IS USED IN SRCHGEN 61200017 PARMN3 DS CL2 N INDICATES LABEL IS USED IN NOTIFY1 61400017 PARMS4 DS CL61 61600017 DS 48C 61800017 ULO DC CL15'USER LOGGED ON ' 62000017 * 62200017 * DUMMY SECTIONS OF DIRECTORIES USED BY LOGON . THESE INCLUDE: 62400017 * 62600017 * 62800017 * USER DIRECTORY 63000017 * 63200017 UDIREC DSECT 63400017 UDIRTERM DS CL8 TERMINAL IDENTIFICATION 63600017 UDIRSTAT DS C STATUS OF USER 63800017 UDIRUSID DS CL3 USER IDENTIFICATION 64000017 UDIRUKEY DS CL3 USERS KEY 64200017 * 64400017 * TERMINAL DIRECTORY 64600017 * 64800017 TDIREC DSECT 65000017 TDIRTERM DS CL8 TERMINAL IDENTIFICATION 65200017 TDIRUSID DS CL3 USER ID 65400017 TDIRSTAT DS C STATUS BYTE 65600017 TDIRRB DS C RETAIN PERIOD BYTE 65800017 * 66000017 FASTAB DSECT 66200017 FASTNAME DS CL8 'JOBNAME' FROM JCL JOB CARD 66400017 FASTJIB DS C JOB INFORMATION BYTE 66600017 FASTJEDT DS CL3 ADDRESS OF JED TABLE 66800017 FASTDSB DS C DELIVERY STATUS BYTE 67000017 FASTDSBE DS C 67200017 FASTTTR DS CL3 67400017 FASTALT DS CL3 67600017 FASTCNT DS C 67800017 FASTUSE DS CL3 USERID 68000017 IHKDSECT ,,,,,AVT 000A 68200017 END 68400017 ./ ADD SSI=03013110,NAME=IHKCBRJS,SOURCE=0 RJS TITLE 'RJSTART' 00200019 IHKCBRJS CSECT 00400019 *3540093000,105000-132000,435000,450000,498000,504000-510000, 000A 00600019 *3540549000,657000,681000,759000,783000,795000,804000,810000, 000A 00800019 *3540816000-822000 000A 01000019 *1710369000-378000,411000,426000,483000,867000-876000,906000 000B 01200019 *1710027000 000B 01400019 *********************************************************************** 01600019 * * 01800019 *STATUS. * 02000019 * CHANGE LEVEL 2 000B 02200019 * * 02400019 *FUNCTION/OPERATION. * 02600019 * THIS ROUTINE IS SUBJECT TO DOUBLE PROCESSING. ON THE FIRST PASS * 02800019 * THE TERMID WILL BE VALIDATED. IF IT IS INVALID AN ERROR RETURN * 03000019 * CODE IS SENT BACK. IF THE TERMID IS VALID, A SUCCESSFUL CODE IS * 03200019 * RETURNED ALONG WITH THE ADDRESS OF THE TERMINAL DIRECTORY ENTRY. * 03400019 * ALL OF THE ABOVE IS DONE AGAIN ON THE SECOND PASS. IN ADDITION * 03600019 * IF THE RJSTART REQUEST IS VALID, THE FOLLOWING IS ALSO DONE- * 03800019 * (1) IF YES WAS SPECIFIED, BROADCAST MESSAGES ARE ENQUEUED. * 04000019 * (2) IF ANY 'NOTIFIES PENDING RJSTART' EXIST,THEY ARE ENQUEUED BY * 04200019 * USER. THAT IS ALL NOTIFIES GOING TO ONE USER ARE TOGETHER . * 04400019 * THE 'NOTIFY PENDING' BITS IN THE UDIR, TDIR, AND FASTTAB ENTRIES * 04600019 * ARE TURNED OFF. * 04800019 * (3) IF ANY 'BYPASSED OUTPUT' EXISTS, IT IS ALSO ENQUEUED BY USER * 05000019 * AND THE BITS TURNED OFF IN THE TDIR AND UDIR ENTRIES. * 05200019 * (4) ANY MESSAGES PENDING ON DISK ARE ENQUEUED. * 05400019 * (5) THE 'ENQUEUE MESSAGES' AND 'ENQUEUE JOBS' BITS ARE SET IN THE * 05600019 * TERMINAL DIRECTORY ENTRY. * 05800019 * (6) ALL DIRECTORY ENTRIES WHICH WERE MODIFIED ARE WRITTEN TO DISK.* 06000019 * (7) AN 'RJSTART ACCEPTED' MESSAGE IS ENQUEUED. * 06200019 * * 06400019 *ENTRY POINTS. * 06600019 * IHKCBRJS IS THE ONLY ENTRY POINT. THE CALLING SEQUENSE IS- * 06800019 * * 07000019 * LA 1,ADDRESS VECTOR TABLE 000A 07200019 * CALL IHKCBRJS 000A 07400019 * * 07600019 *INPUT. * 07800019 * REGISTER 1 POINTS TO THE ADDRESS VECTOR TABLE WHOSE DESCRIPTION000A 08000019 * APPEARS BEFORE THE EXPANSION OF THE DSECT IHKZZAVT. 000A 08200019 * FIRST PASS IS INDICATED BY THE HIGH ORDER BIT OF REGISTER ONE * 08400019 * BEING SET TO ONE, SECOND PASS- ZERO. * 08600019 * * 08800019 *OUTPUT. * 09000019 * APPROPRIATE SYSTEM MESSAGES ARE ENQUEUED ALONG WITH ANY * 09200019 * BYPASSED OUTPUT. ALL TABLE OR DIRECTORY ENTRIES IN WHICH BITS * 09400019 * WERE SET ARE WRITTEN ON DISK. * 09600019 * * 09800019 *EXTERNAL ROUTINES. * 10000019 * IHKCBSTD- SEARCH FOR TERMINAL DIRECTORY ENTRY. * 10200019 * IHKCFBDR- CREATES DUMMY QEB'S FOR BROADCAST MESSAGES AND FOR * 10400019 * MESSAGES ON THE DATA SET RJETXT. * 10600019 * IHKCCSGN- SEARCH FOR JOBS WITH NOTIFY PENDING RJSTART AND * 10800019 * BYPASSED OUTPUT * 11000019 * IHKCFQOP- ENQUEUE BYPASSED OUTPUT. * 11200019 * IHKCBLDM- ENQUEUE NOTIFY AND ACCEPTANCE MESSAGES * 11400019 * IHKCDTMR- WRITE UPDATED TDIR ENTRY TO DISK * 11600019 * IHKCDUMR- WRITE UPDATED UDIR ENTRY TO DISK * 11800019 * IHKCDFMR- WRITE UPDATED FAST TAB TO DISK * 12000019 * IHKCDJMR- READ JED TABLE ENTRY FOR NOTIFY MESSAGES * 12200019 * * 12400019 *EXITS-NORMAL. * 12600019 * REGISTER FIFTEEN CONTAINS A RETURN CODE OF ZERO. REGISTER ONE * 12800019 * CONTAINS THE ADDRESS OF THE TERMINAL DIRECTORY ENTRY FROM WHICH * 13000019 * THE RJSTART WAS RECEIVED. * 13200019 * * 13400019 *EXITS-ERROR. * 13600019 * REGISTER FIFTEEN CONTAINS A RETURN CODE OF FOUR. REGISTER ONE * 13800019 * CONTAINS BINARY ZEROS. * 14000019 * * 14200019 *TABLES/WORK AREAS. * 14400019 * FAST TABLE- LIST FO ACTIVE JOBS IN SYSTEM AND ASSOCIATED DATA. * 14600019 * JED TABLE - EXTENSION OF FAST TABLE, CONTAINS NOTIFY INFORMATION * 14800019 * AND SYSOUT CLASS * 15000019 * USER DIRECTORY- LIST OF AUTHORIZED USERS AND ASSOCIATED DATA * 15200019 * TERMINAL DIRECOTRY- LIST OF POTENTIAL REMOTE TERMINALS AVAILABLE * 15400019 * TO RJE AND ASSOCIATED DATA * 15600019 * * 15800019 *ATTRIBUTES. * 16000019 * SERIALLY REUSABLE * 16200019 * NON-RESIDENT 000A 16400019 * * 16600019 *NOTES. * 16800019 * NO MESSAGES ARE ENQUEUED IF THE RJSTART IS INVALID. THIS IS * 17000019 * BECAUSE AT THE TIME INVALIDITY FOUND, THE TERMINAL DIRECTORY * 17200019 * ENTRY FOR THIS TERMINAL IS NOT KNOWN. WHEN AN RJSTART IS REJECTED,* 17400019 * THE LINE IS LOGICALLY DISCONNECTED FROM RJE. THIS IS THE ONLY * 17600019 * INDICATION OF AN INVALID RJSTART. * 17800019 * * 18000019 *********************************************************************** 18200019 R0 EQU 0 PARAMETER PASSING 18400019 R1 EQU 1 PARAMETER PASSING 18600019 R2 EQU 2 ADDRESS OF INPUT PARAMETERS 18800019 R3 EQU 3 WORK 19000019 R4 EQU 4 ADDRESS OF TERMINAL DIRECOTRY ENTRY 19200019 R5 EQU 5 NUMBER OF ENTRIES IN USER DIRECTORY 19400019 VCONBASE EQU 6 000A 19600019 R6 EQU 6 LENGTH OF ENTRY IN USER DIRECTORY 19800019 R7 EQU 7 ADDRESS OF USER DIRECTORY ENTRY 20000019 R8 EQU 8 ADDRESS OF FAST TABLE ENTRY 20200019 R9 EQU 9 MESSAGE OFFSET 20400019 R10 EQU 10 RETURN ADDRESS FROM SRCHGEN, USERMGR 20600019 R11 EQU 11 RETURN POINT FROM BUILDMSG 20800019 R12 EQU 12 BASE 21000019 R13 EQU 13 SAVE AREA POINTER 21200019 R14 EQU 14 RETURN ADDRESSES 21400019 R15 EQU 15 ENTRY ADDRESSES 21600019 SAVE (14,12) SAVE REGISTERS AND SET UP ADDRESS- 21800019 BALR R12,R0 ABILITY 22000019 USING *,R12 22200019 B A 22400019 DC C'IHKCBRJS' 22600019 A DS 0H 22800019 USING IHKZZAVT,VCONBASE 000A 23000019 LA R10,SAVE 23200019 ST R10,8(R13) 23400019 ST R13,4(R10) 23600019 LR R13,R10 23800019 LR VCONBASE,R1 000A 24000019 ST VCONBASE,VCONSAVE 000A 24200019 MVI VCONSAVE,X'FF' SET FLAG FOR IHKCFBDR 000A 24400019 L R2,4(R1) SAVE INPUT POINTER 24600019 L R4,0(R1) 24800019 USING TDIREC,R4 25000019 OI TDIRSTAT,X'30' SET ENQUEUE JOBS AND MESSAGES BITS 25200019 CLI 80(R2),C'R' 25400019 BNE DELAYED 25600019 OI TDIRSWCH+1,X'60' SET CONTINUE HERE 25800019 L R10,IHKZZRCS GET ADDRESS OF COMM. SWITCHES A24719 25850019 TM 0(R10),X'28' WARMSTART IN PROCESS? A24719 25900019 BZ RJSNOBIT NO, DO NOT TURN ON BIT A24719 25950019 OI TDIRSWCH,X'10' INSURE THAT RJSTART IS SET 000B 26000019 RJSNOBIT DS 0H A24719 26100019 NI TDIRSTAT,X'F3' TURN OFF DEQUEUE NOTHING 26200019 CLI 89(R2),C'N' IS BROADCAST TO BE SENT 26400019 BE DELAYED IF NOT, CHECK FOR DELAYED MESSAGES 26600019 ST R2,PARMLIST+4 000A 26800019 BAL R3,BRDCST1 000B 27000019 DELAYED TM TDIRSTAT,2 ANY DELAYED MESSAGES TO BE SENT 27200019 BE NOTIFY IF NOT GO CHECK FOR PENDING NOTIFIES 27400019 XR R3,R3 27600019 ST R3,PARMLIST+4 000A 27800019 C R3,ADBDR HAS IHKCFBDR BEEN LOADED 000B 28000019 LA R3,NOTIFY RETURN POINT FROM IHKCFBDR 000B 28200019 BE BRDCST1 LOAD IHKCFBDR AND BALR TO IT 000B 28400019 B BRDCST IF LOADED BALR TO IT 000B 28600019 NOTIFY TM TDIRSTAT,192 ANY NOTIFIES PENDING RJSTART OR 28800019 * BYPASSED OUTPUT. 29000019 BNE NTFYCHCK IF SO- FIND AND ENQUEUE THEM 29200019 ACCEPT CLI 80(R2),C'R' 29400019 BNE ENDUP 29600019 NI TDIRSTAT,X'B2' ZERO STATUS EXCEPT RJETXT,BYPASSED 29800019 MVI TDIRSECB,X'00' INSURE STOP ECB IS NOT POSTED 30000019 LR R1,R4 WRITE UPDATED TERMINAL DIRECTORY 30200019 L R15,IHKZZTMR 000A 30400019 BALR R14,R15 000A 30600019 LA R9,7 SEND ACCEPTANCE MESSAGE 30800019 MVC PARM3(8),72(R2) SEQUENCE NUMBER 31000019 LA R3,8 LENGTH OF MESSAGE PARAMETERS 31200019 BAL R11,BUILDMSG ENQUEUE MESSAGE 31400019 XC IHKCBPRM,IHKCBPRM INDICATE MESSAGE TO CENTRAL 000B 31600019 MVC PARM3(8),TDIRTERM PUT TERMID INTO MESSAGE 000B 31800019 MVI PARM3+8,C' ' 000B 32000019 L R1,TDIRLCB GET ADDRESS OF LCB 000B 32200019 LTR R1,R1 HAVE ADDRESS OF LCB 000B 32400019 BZ ENDUP NO, HANG IT UP 000B 32600019 USING LCBDSECT,R1 000B 32800019 L R1,LCBLDECB GET ADDRESS OF DECB 000B 33000019 DROP R1 000B 33200019 USING IECTDECB,R1 000B 33400019 XR R15,R15 CLEAR REGISTER 000B 33600019 IC R15,DECRLN GET RELATIVE LINE NUMBER 000B 33800019 L R1,DECDCBAD GET ADDRESS OF DCB 000B 34000019 DROP R1 000B 34200019 USING IHADCB,R1 000B 34400019 L R1,DCBDEBAD GET ADDRESS OF DEB 000B 34600019 DROP R1 000B 34800019 SLL R15,2 MULTIPLY RLN BY FOUR 000B 35000019 L R1,28(R15,R1) GET UCB ADDRESS 000B 35200019 USING UCB,R1 000B 35400019 MVC PARM3+9(3),UCBNAME MOVE LINE NAME INTO MSG 000B 35600019 DROP R1 000B 35800019 MVI PARM2,X'0C' GET LENGTH OF MESSAGE 000B 36000019 BAL R11,BMG GO TO BUILD MESSAGE ROUTINE 000B 36200019 ENDUP DS 0H 000A 36400019 L R3,ADBDR ADDRESS OF IHKCFBDR IF LOADED 000B 36600019 LTR R3,R3 WAS MODULE EVER LOADED 000B 36800019 BE RETURN IF NOT DON'T DELETE 000B 37000019 DELETE EPLOC=RJSADBDR 000A 37200019 RETURN LR R1,R4 000B 37400019 L R13,SAVE+4 000B 37600019 L R14,12(R13) 37800019 XR R15,R15 38000019 L R0,20(R13) 38200019 RETURN (2,12),T RETURN TO COMMAND INTERPRETER 38400019 * 38600019 * * 38800019 * THIS SUBROUTINE SEARCHES THE USER DIRECTORY FOR ANY NOTIFIES * 39000019 * PENDING RJSTART. * 39200019 * 39400019 * CHECK FOR UNDELIVERED IMMEDIATE OUTPUT 39600019 * 39800019 * * 40000019 NTFYCHCK EQU * 40200019 NI TDIRSTAT,X'7F' TURN OFF BYPASSED OUTPUT BIT 40400019 LOAD EPLOC=RJSADQOP 000B 40600019 ST R0,ADQOP 000B 40800019 LA R1,DUMWAIT DUMMY ECB 000B 41000019 L R15,IHKZZDSP ADDRESS OF DISPATCHER 000B 41200019 BALR R14,R15 DUMMY WAIT I N DISPATCHER 000B 41400019 L R5,IHKZZUNB GET NUMBER OF USER DIR. ENTRIES 000A 41600019 LH R5,0(R5) 41800019 L R6,IHKZZULN GET LENGTH OF EACH ENTRY 000A 42000019 MVC LEN,0(R6) 000A 42200019 L VCONBASE,VCONSAVE 000A 42400019 L R7,IHKZZUDR GET START OF USER DIRECTORY 000A 42600019 LA R5,1(R5) INITIALIZE COUNT 42800019 REPEAT BCT R5,TFRMCHCK 43000019 DELETE EPLOC=RJSADQOP 000B 43200019 B ACCEPT 43400019 USING UDIREC,R7 43600019 TFRMCHCK CLC TDIRTERM(8),UDIRTERM WAS USER LAST LOGGED ON AT THIS 43800019 * TERMINAL 44000019 BNE NEXT IF NOT GO TO NEXT ENTRY 44200019 TM UDIRSTAT,8 TEST NOTIFY PENDING TERMINAL STARTUP 44400019 * BIT IN USER DIRECTORY 44600019 BO FASTSRCH IF ON SEARCH FASTABLE 44800019 IMOPRJS TM UDIRSTAT,128 ANY BYPASSED OUTPUT PENDING RJSTART 45000019 BO IMOPCHCK 45200019 NEXT AH R7,LEN 000A 45400019 B REPEAT REPEAT USER DIRECTORY SEARCH 45600019 * * 45800019 * THIS SUBROUTINE SEARCHES THE FAST TABLE FOR THE JOB WHICH IS TO BE* 46000019 * MADE KNOWN TO THE USER AT RJSTART. IT ALSO TURNS OFF THE 'NOTIFY * 46200019 * PENDING TERMIANL STARTUP' BIT IN THE USER DIRECTORY ENTRY. * 46400019 * * 46600019 FASTSRCH XR R3,R3 LOAD PARAMETERS FOR FAST TABLE 46800019 ST R3,IHKCBPRM SEARCH SO THAT ONLY JOBS FOR WHICH 47000019 * THERE IS A NOTIFY SOURCE 47200019 OVER MVI PARM3+3,C'T' 47400019 MVC PARM1(3),UDIRUSID 47600019 BAL R10,SRCHGEN SEARCH THE FAST TABLE 47800019 LTR R15,R15 48000019 BZ ENQUEUE IF JOB FOUND ENQUEUE NOTIFY MESSAGE 48200019 NI UDIRSTAT,247 TURN OFF 'NOTIFY PENDING TERMINAL 48400019 * STARTUP' BIT IN USER DIRECTORY ENTRY 48600019 B IMOPRJS GO TO TEST FOR IMMEDIATE OUTPUT 48800019 * * 49000019 * ENQUEUE NOTIFY MESSAGE,-TURN OFF NOTIFY PENDING RJSTART IN FAST * 49200019 * TABLE, TURN ON SOURCE NOTIFICATION BIT, WRITE UPDATED FAST TABLE * 49400019 * ENTRY ON DISK * 49600019 * * 49800019 USING FASTAB,R8 50000019 ENQUEUE LR R8,R1 50200019 MVC PARM3(8),FASTNAME JOBNAME 50400019 MVI PARM3+8,C' ' 50600019 MVC PARM3+9(3),UDIRUSID USER ID 50800019 TM FASTDSB,16 DID JOB END NORMALLY 51000019 BO ABNORM IF NOT SET OFFSET 'ABEND NOTIFY' 51200019 LA R9,31 MESSAGE OFFSET 51400019 INFO TM FASTJIB,8 IS THERE ANY NOTIFY INFORMATION 51600019 BZ GONOTIFY IF NOT SEND MESSAGE 51800019 LA R0,PARM3+13 IF YES, FETCH NOTIFY INFORMATION 52000019 * FROM DISK 52200019 ST R8,PARMLIST 000A 52400019 ST R0,PARMLIST+4 000A 52600019 LA R1,PARMLIST 000A 52800019 L R15,IHKZZJMR 000A 53000019 BALR R14,R15 000A 53200019 MVI PARM3+12,C' ' 53400019 LA R3,38 53600019 SEND BAL R11,BUILDMSG 53800019 OI FASTDSB,8 TURN ON SOURCE NOTIFICATION BIT 54000019 NI FASTDSB,253 TURN OFF NOTIFY PENDING RJSTART IN 54200019 * FAST TAB ENTRY 54400019 ST R8,IHKCBPRM 54600019 B OVER REPEAT SEARCH OF FAST TABLE 54800019 ABNORM LA R9,38 MESSAGE OFFSET 55000019 B INFO 55200019 GONOTIFY LA R3,12 55400019 B SEND 55600019 IMOPCHCK XR R3,R3 55800019 NI UDIRSTAT,127 TURN OFF BYPASSED OUTPUT BIT 56000019 ST R3,IHKCBPRM 56200019 ST R3,PARM1 56400019 MVI PARM3+3,C'I' 56600019 SRCH BAL R10,SRCHGEN FIND JOB IN FAST TABLE 56800019 LTR R15,R15 57000019 BNE NEXT IF NOT FOUND GO TO NEXT USER 000B 57200019 * OUTPUT OFF 57400019 LR R8,R1 57600019 ST R8,IHKCBPRM 57800019 TM FASTDSBE,128 ALTERNATE OR SOURCE BYPASSED OUTPUT 58000019 BZ ALT IF ALTERNATE, TURN OFF BYPASSED 58200019 * OUTPUT FOR ALTERNATE 58400019 NI FASTDSBE,127 TURN OFF BYPASSED OUTPUT SOURCE 58600019 B OUTPUT 58800019 ALT NI FASTDSBE,191 TURN OFF BYPASSED OUTPUT ALTERNATE 59000019 MVI IHKCBPRM,X'80' 59200019 OUTPUT L R1,IHKCBPRM 59400019 ST R4,PARMLIST 000A 59600019 ST R1,PARMLIST+4 000A 59800019 LA R1,PARMLIST 000A 60000019 L R15,ADQOP 000A 60200019 BALR R14,R15 000A 60400019 B SRCH 60600019 BUILDMSG STH R9,PARM1 60800019 ST R4,IHKCBPRM 61000019 STC R3,PARM2 61200019 BMG LA R1,IHKCBPRM 000A 61400019 L R15,IHKZZLDM 000A 61600019 BALR R14,R15 000A 61800019 BR R11 62000019 SRCHGEN LA R1,IHKCBPRM 62200019 MVC PARM3(3),UDIRUSID 62400019 L R15,IHKZZSGN 000A 62600019 BALR R14,R15 000A 62800019 BR R10 63000019 BRDCST1 LOAD EPLOC=RJSADBDR 000B 63200019 ST R0,ADBDR 000B 63400019 LA R1,DUMWAIT DUMMY ECB 000B 63600019 L R15,IHKZZDSP ADDRESS OF DISPATCHER 000B 63800019 BALR R14,R15 DUMMY WAIT I N DISPATCHER 000B 64000019 BRDCST ST R4,PARMLIST 000A 64200019 LA R1,PARMLIST 000A 64400019 L R15,ADBDR 000A 64600019 BALR R14,R15 000A 64800019 BR R3 65000019 LEN DS H 000A 65200019 RJSADQOP DC C'IHKCFQOP' 000A 65400019 ADQOP DS F 000A 65600019 DUMWAIT DC X'40000000' 000B 65800019 RJSADBDR DC C'IHKCFBDR' 000A 66000019 ADBDR DC F'0' 000B 66200019 PARMLIST DS 2F 000A 66400019 VCONSAVE DS F 000A 66600019 SAVE DS 18F 66800019 IHKCBPRM DS F 67000019 PARM1 DS H 67200019 PARM2 DS C 67400019 PARM3 DS CL112 67600019 UDIREC DSECT 67800019 UDIRTERM DS CL8 68000019 UDIRSTAT DS C 68200019 UDIRUSID DS CL3 68400019 FASTAB DSECT 68600019 FASTNAME DS CL8 68800019 FASTJIB DS CL4 69000019 FASTDSB DS C 69200019 FASTDSBE DS C 69400019 IHKDSECT ,,,,,AVT 000A 69600019 IHKDSECT TDIR 000B 69800019 IHKDSECT ,,,,LCB 000B 70000019 EJECT 70200019 IECTDECB 000B 70400019 EJECT 70600019 DCBD DSORG=(BS,BX),DEVD=DA 000B 70800019 EJECT 71000019 UCB DSECT 000B 71200019 IEFUCBOB 000B 71400019 END 71600019 ./ ADD SSI=00012992,NAME=IHKCBSTD,SOURCE=0 TITLE 'IHKCBSTD' 00700015 IHKCBSTD CSECT 01400015 *STATUS: * 02100015 * CHANGE LEVEL 0 * 02800015 *FUNCTION/OPERATION: * 03500015 * THIS ROUTINE PERFORMS A SERIAL SEARCH OF THETERMINAL DIRECTORY, * 04200015 * LOOKING FOR THE ENTRY OF A SPECIFIED TERMINAL IDENTIFICATION. * 04900015 * * 05600015 *ENTRY POINTS: * 06300015 * IHKCBSTD IS THE ONLY ENTRY POINT. * 07000015 * IHKCBSTD - FIND TERMINAL DIRECTORY ENTRY * 07700015 * LA 1,TERMINAL IDENTIFICATION * 08400015 * CALL SRCHTID * 09100015 * * 09800015 * DATA IS PASSED TO THIS ROUTINE BY ITS LOCATION * 10500015 * * 11200015 *INPUT: * 11900015 * STANDARD SUBROUTINE LINKAGE PREVAILS.REGISTER ONE POINTS TO * 12600015 * AN EIGHT BYTE TERMINAL IDENTIFICATION, FOR WHICH THE USER WANTS * 13300015 * THE CORRESPONDING ENTRY IN THE TERMINAL DIRECTORY. IF THE * 14000015 * TERMINAL ID IS NOT EIGHT BYTES LONG, IT SHOULD BE LEFT ADJUSTED * 14700015 * AND PADDED WITH BLANKS, HEX 40'S, TO THE RIGHT. * 15400015 * * 16100015 *OUTPUT: * 16800015 * NO OUTPUT EXCEPT THAT LISTED UNDER 'EXITS'. * 17500015 * * 18200015 *EXTERNAL ROUTINES: * 18900015 * N/A * 19600015 * * 20300015 *EXITS-NORMAL: * 21000015 * REGISTER ONE POINTS TO THE FIRST BYTE OF THE FOUND TERMINAL * 21700015 * DIRECTORY ENTRY. REGISTER FIFTEEN CONTAINS A RETURN CODE OF ZERO.* 22400015 * * 23100015 *EXITS-ERROR: * 23800015 * REGISTER ONE REMAINS UNCHANGED. REGISTER FIFTEEN HAS A RETURN * 24500015 * CODE OF FOUR. * 25200015 * * 25900015 *TABLES/WORK AREAS: * 26600015 * THE TERMINAL DIRECTORY CONSISTS OF AN ENTRY FOR * 27300015 * EACH POTENIAL REMOTE TERMINAL AVAILABLE TO THE SYSTEM. WITHIN * 28000015 * EACH 13 BYTE ENTRY IS AN EIGHT BYTE TERMINAL ID, A THREE BYTE * 28700015 * USER ID, A STATUS BYTE, AND A RETAIN PERIOD BYTE. * 29400015 * * 30100015 *ATTRIBUTES: * 30800015 * SERIALLY REUSABLE. 31500015 * * 32200015 *NOTES: * 32900015 * N/A * 33600015 * * 34300015 * 35000015 *********************************************************************** 35700015 * 36400015 * GENERAL REGISTERS 37100015 TERMID EQU 1 ADDRESS OF TERMINAL ID 37800015 TLENT EQU 7 LENGTH OF TDIR ENTRY 38500015 TNUMB EQU 8 NUMBER OF ENTRIES IN TABLE 39200015 BUMP EQU 9 INCREMENT IN BXLE INSTRUCTION 39900015 SRCHBASE EQU 11 BASE REGISTER FOR DSECT 40600015 BASE EQU 12 BASE REGISTER FOR SRCHTID 41300015 RTRNCODE EQU 15 RETURN CODE 42000015 * 42700015 ************** *********** 43400015 * 44100015 STM 14,12,12(13) SAVE REGISTERS 44800015 BALR BASE,0 SET UP ADDRESSABILITY USIING 45500015 USING *,BASE REGISTER 12 (BASE) 46200015 LA 10,SAVE 46900015 ST 10,8(13) STORE MY SAVE ADDRESS IN HIS SAVE 47600015 ST 13,4(10) STORE HIS SAVE ADDRESS IN MY AREA 48300015 * 49000015 * 49700015 * INITIALIZE COUNTERS FOR LOOP CONTROL 50400015 * 51100015 * 51800015 LA BUMP,1 SET VALUE OF INCREMENT FOR BXLE 52500015 LNR BUMP,BUMP INSTRUCTION 53200015 L TLENT,ADTLENT FIND LENGTH OF EACH ENTRY 53900015 LH TLENT,0(TLENT) 54600015 L TNUMB,ADTNUMB FIND NUMBER FO ENTRIES IN TERMINAL 55300015 LH TNUMB,0(TNUMB) TABLE 56000015 * 56700015 * 57400015 * SET UP ADDRESSABILITY WITHIN DSECT 58100015 * 58800015 * 59500015 L SRCHBASE,ADTDIR USE ADDRESS OF FIRST BYTE IN 60200015 USING TDIREC,SRCHBASE THE TERMINAL DIRECTORY 60900015 * 61600015 * 62300015 * LOOP FOR SERIAL SEARCH OF TERMINAL DIRECTORY. SEEKING 63000015 * TERMINAL NAME EQUAL TO NAME POINTED TO BY REGISTER ONE (TERMID). 63700015 * 64400015 * 65100015 LOOP BXLE TNUMB,BUMP,NOTFOUND LOOP CONTROL,BRANCH IF END TDIR 65800015 CLC TDIRTERM(8),0(TERMID) COMPARE TERMINAL IDS 66500015 BE FOUND IF EQUAL GO TO ROUTINE TO 67200015 * RETURN RESULTS TO CALLER 67900015 AR SRCHBASE,TLENT INCREMENT TO NEXT ENTRY 68600015 B LOOP 69300015 * 70000015 * 70700015 * LOAD RETURN CODE INDICATIONG UNSUCCESSFUL SEARCH AND BRANCH 71400015 * TO ENDUP ROUTINE. 72100015 * 72800015 * 73500015 NOTFOUND LA RTRNCODE,4 74200015 B RETURN 74900015 * 75600015 * 76300015 * LOAD SUCCESSFUL RETURN CODE AND ADDRESS OF TERMINAL 77000015 * IDENTIFICATION 77700015 * 78400015 * 79100015 FOUND LA RTRNCODE,0 79800015 LR TERMID,SRCHBASE PUT ADDRESS OF FOUND ENTRY 80500015 ST TERMID,24(13) IN REGISTER 1 AND RETURN IT 81200015 RETURN ST RTRNCODE,16(13) RETURN TO CALLING ROUTINE 81900015 RETURN (14,12) 82600015 * 83300015 ************** *********** 84000015 * 84700015 * CONSTANTS 85400015 * 86100015 SAVE DC 3F'0' SAVE AREA 86800015 * 87500015 * ADCONS 88200015 * 88900015 ADTLENT DC A(IHKCDTLN) ADDRESS OF TABLE LENGTH 89600015 ADTNUMB DC A(IHKCDTNB) ADDRESS OF NUMBER OF ENTRIES 90300015 ADTDIR DC A(IHKCDTDR) ADDRESS OF TERMINAL DIRECTORY 91000015 * 91700015 ************** *********** 92400015 * DSECT DEFINING TERMINAL DIRECTORY 93100015 ************** *********** 93800015 TDIREC DSECT 94500015 TDIRTERM DS CL8 TERMINAL IDENTIFICATION 95200015 TDIRUSID DS CL3 USER IDENTIFICATION 95900015 TDIRSTAT DS C STATUS BYTE 96600015 TDIRRB DS C RETAIN PERIOD BYTE 97300015 EXTRN IHKCDTDR,IHKCDTNB,IHKCDTLN 98000015 END 98700015 ./ ADD SSI=00012850,NAME=IHKCBUID,SOURCE=0 TITLE 'IHKCBUID - USERID COMMAND ' 00600015 IHKCBUID CSECT 01200015 * * 01800015 *STATUS. * 02400015 * CHANGE LEVEL 0 * 03000015 * * 03600015 *FUNCTION/OPERATION. * 04200015 * THIS ROUTINE ADDS OR DELETES USERS FROM THE USER DIRECTORY. THE * 04800015 * COMMAND CAN BE SUBMITTED ONLY AT THE CENTRAL. ALL MESSAGES ORIGIN-* 05400015 * ATING IN IHKCBUID ARE RETURNED TO THE CENTRAL CONSOLE. IF THE * 06000015 * COMMAND IS AN ADDITION, THE USER ID AND PROTECTION KEY ARE * 06600015 * INSERTED INTO AN EMPTY ENTRY, AND AN 'ADDED TO USER DIRECTORY' * 07200015 * MESSAGE IS SENT. IF THE USER DIRECTORY HAS NO EMPTY ENTRIES, A * 07800015 * 'USER DIRECTORY FULL' MESSAGE IS RETURNED, AND NO FURTHER ACTION * 08400015 * IS TAKEN. * 09000015 * IF THE COMMAND IS A DELETION, ALL FIELDS OF THE ENTRY ARE FILLED * 09600015 * WITH BLANKS EXCEPT FOR THE TTR POINTER. THE STATUS BYTE IS THEN * 10200015 * CLEARED TO ZERO, AND A 'DELETED FROM USER DIRECTORY' MESSAGE IS * 10800015 * SENT. IF THE COMMAND HAS A USER ID WHICH IS FOUND IN THE USER * 11400015 * DIRECTORY BUT THE PROTECTION KEYS DO NOT MATCH, THEN AN 'INVALID * 12000015 * PROTECTION KEY' MESSAGE IS RETURNED. * 12600015 * FOR VALID ADDITIONS AND DELETIONS, ONCE THE ENTRIES ARE REVISED, * 13200015 * THE NEW VERSION IS WRITTEN TO DISK. * 13800015 * * 14400015 *ENTRY POINTS. * 15000015 * IHKCBUID IS THE ONLY ENTRY POINT. THE CALLING SEQUENCE IS- * 15600015 * * 16200015 * LOAD EP=IHKCBUID * 16800015 * LR 15,0 * 17400015 * LA 1,PARAMETER LIST * 18000015 * BALR 14,15 * 18600015 * DELETE EP=IHKCBUID * 19200015 * * 19800015 *INPUT. * 20400015 * REGISTER ONE POINTS TO A PARAMETER LIST WHICH HAS THE FORMAT- * 21000015 * BYTES CONTENTS * 21600015 * 0-79 CARD IMAGE OF USERID COMMAND * 22200015 * 80 U * 22800015 * 81-83 USER ID * 23400015 * 84-86 PROTECTION KEY * 24000015 * 87-94 BLANK * 24600015 * * 25200015 *OUTPUT. * 25800015 * AN APPROPRIATE SYSTEM MESSAGE IS SENT TO THE CENTRAL OPERATOR. IF * 26400015 * THE COMMAND IS VALID THE ADDITION OF DELETION IS PERFORMED AND THE* 27000015 * UPDATED CORE VERSION IS WRITTEN TO DISK. * 27600015 * * 28200015 *EXTERNAL ROUTINES. * 28800015 * IHKCCSUD - SEARCHES THE USER DIRECTORY ON THE USER ID. * 29400015 * IHKCDUMR - WRITES THE UPDATED ENTRY TO DISK. * 30000015 * IHKCBLDM - ENQUEUES SYSTEM MESSAGES TO CENTRAL OPERATOR. * 30600015 * * 31200015 *EXITS-NORMAL. * 31800015 * RETURN TO CALLING PROGRAM. * 32400015 * * 33000015 *EXITS-ERROR. * 33600015 * N/A * 34200015 * * 34800015 *ATTRIBUTES. * 35400015 * SERIALLY REUSABLE AND NON-RESIDENT. * 36000015 * * 36600015 *NOTES. * 37200015 * N/A * 37800015 * * 38400015 * * 39000015 * GENERAL REGISTER UTILIZATION * 39600015 * * 40200015 * * 40800015 R0 EQU 0 PARAMETER PASSING 41400015 R1 EQU 1 PARAMETER PASSING 42000015 R2 EQU 2 POINTER TO INPUT (EXTENDED CARD IMAGE) 42600015 R3 EQU 3 43200015 R4 EQU 4 MESSAGE OFFSET FOR BUILD MESSAGE 43800015 R5 EQU 5 LENGTH OF MESSAGE TEXT FOR BUILD MESSAGE 44400015 R6 EQU 6 POINTER TO INPUT PARAMETER LIST 45000015 R11 EQU 11 SAVE AREA POINTER 45600015 R12 EQU 12 BASE REGISTER 46200015 R13 EQU 13 SAVE AREA POINTER 46800015 R14 EQU 14 RETURN POINT 47400015 R15 EQU 15 ENTRY POINT 48000015 SAVE (14,12) SAVE REGISTERS 48600015 BALR R12,R0 49200015 USING *,R12 SET UP ADDRESSABILITY 49800015 LA R11,SAVE 50400015 ST R11,8(R13) SET UP SAVE AREAS FOR TRACE 51000015 ST R13,4(R11) 51600015 LR R13,R11 ADDRESS OF IHKCBRJS SAVE AREA 52200015 LR R6,R1 52800015 L R2,4(R6) SAVE POINTER TO CARD IMAGE 53400015 MVC PARM3+1(3),81(R2) 54000015 L R1,PARM3+1 54600015 L R15,44(R6) ADDRESS OF IHKCCSUD 55200015 BALR R14,R15 SEARCH USER DIRECTORY FOR USER'S 55800015 * ENTRY 56400015 LTR R1,R1 WAS USER ENTRY FOUND 57000015 BE ADD IF NOT REQUEST IS AN ADDITION 57600015 CLI 87(R2),C'D' ADD OR DELETE 58200015 BNE BADUSID IF ADD RETURN INVALID MESSAGE 58800015 CLC 12(3,R1),84(R2) IF FOUND COMPARE PROTECTION KEYS 59400015 BNE INVALID IF KEYS NOT EQUAL, RETURN ERROR CODE 60000015 MVI 0(R1),X'40' IF EQUAL, FREE USER DIRECTORY ENTRY 60600015 MVC 1(14,R1),0(R1) BY ZEROING OUT ENTRY. 61200015 MVI 8(R1),X'00' ZERO STATUS BYTE 61800015 LA R4,14 MESSAGE OFFSET 62400015 B UPDATE 63000015 ADD CLI 87(R2),C'A' ADD OR DELETE 63600015 BNE BADUSID IF DELETE RETURN INVALID MESSAGE 64200015 L R1,BLANK SET UP SEARCH FOR EMPTY USER ENTRY 64800015 BALR R14,R15 SEARCH FOR EMPTY ENTRY 65400015 LTR R1,R1 EMPTY ENTRY FOUND 66000015 BE FULL IF NOT SEND DIRECTORY FULL MESSAGE 66600015 MVC 9(6,R1),81(R2) IF FOUND INSERT USERID AND KEY 67200015 LA R4,26 MESSAGE OFFSET 67800015 UPDATE L R15,52(R6) ADDRESS OF IHKCDUMR 68400015 BALR R14,R15 WRITE UPDATED USER ENTRY ON DISK 69000015 PREMSG LA R5,7 LENGTH 69600015 MVC PARM3(3),81(R2) USER ID 70200015 MVI PARM3+3,C' ' BLANK 70800015 MVC PARM3+4(3),84(R2) KEY 71400015 BUILDMSG STH R4,PARM1 72000015 STC R5,PARM2 72600015 LA R1,PARM 73200015 L R15,20(R6) ADDRESS OF IHKCBLDM 73800015 BALR R14,R15 ENQUEUE MESSAGE 74400015 L R13,SAVE+4 75000015 RETURN (14,12),T,RC=0 75600015 FULL LA R4,35 MESSAGE OFFSET 76200015 B PREMSG 76800015 BADUSID LA R4,1 MESSAGE OFFSET 77400015 B PREERROR 78000015 INVALID LA R4,2 MESSAGE OFFSET 78600015 PREERROR LA R5,15 79200015 MVC PARM3(6),=C'USERID' COMMAND 79800015 MVC PARM3+6(9),71(R2) SEQUENCE NUMBER 80400015 B BUILDMSG 81000015 * * 81600015 * CONSTANTS * 82200015 * * 82800015 SAVE DS 18F SAVE AREA 83400015 BLANK DC C' ' BLANKS FOR SEARCH IN ADD 84000015 PARM DC F'0' TERMINAL DESTINATION 84600015 PARM1 DS H MESSAGE OFFSET 85200015 PARM2 DS C LENGTH 85800015 PARM3 DS CL15 MESSAGE TEXT 86400015 * PARAMETERS FOR BUILDMSG - IHKCBLDM 87000015 END 87600015 ./ ADD SSI=02010240,NAME=IHKCCPLM,SOURCE=0 TITLE 'IHKCCPLM-FREEPOOL MANAGER' 00200016 IHKCCPLM CSECT 00230021 *D 648000-660000 A37764 00260021 *A 223000,647000-658000 A37764 00290021 *D 200000-201200 A37779 00320021 *C 488000-490000 A37779 00350021 *C649000 A55181 00370021 *D651000-659000 A58978 00377021 *A651000 A58978 00384021 *C649000 A58978 00391021 *ROUTINE NAME * 00400016 * FREEPOOL MANAGER * 00600016 * * 00800016 * STATUS: CHANGE LEVEL 2, RELEASE 21.7 * 01100021 * * 01400016 *FUNCTION/OPERATION * 01600016 * THIS ROUTINE SUPPLIES QUEUE ENTRY BLOCKS (QEB) TO THE VARIOUS * 01800016 * MODULES WHICH BUILD QUEUE ENTRYS FOR THE RJE INPUT AND OUTPUT * 02000016 * STREAMS. THESE QEB ARE MAINTAINED IN THE RJE FREEPOOL, A BUFFER * 02200016 * POOL CONSISTING OF TWO SUBPOOLS. THE CORE FOR THE BUFFER POOL AND * 02400016 * POOL CONTROL LISTS FOR EACH SUBPOOL IS SEPARATELY ASSEMBLED IN THE* 02600016 * FREEPOOL MODULE. THIS MODULE IS CONTROLLED AND ACCESSED ONLY BY * 02800016 * THE FREEPOOL MANAGER. * 03000016 * * 03200016 *ENTRY POINTS * 03400016 * IHKCCPLM-THIS LABEL IS THE ONLY ENTRY POINT. ENTRY IS MADE * 03600016 * FOR THE PURPOSE OF RETURNING A QEB TO A SUBPOOL (A RELEASE * 03800016 * REQUEST), OR FOR OBTAINING A QEB FROM A SUBPOOL (RETRIEVE REQUEST)* 04000016 * THE CALLING SEQUENCE IN EITHER CASE MIGHT BE- * 04200016 * L 2,ADDRESS SPECIFYING WHICH POOL. * 04400016 * L 3,ADDRESS SPECIFYING RETRIEVE OR RELEASE. * 04600016 * CALL IHKCCPLM,((2),(3)) * 04800016 * * 05000016 * AS ILLUSTRATED BY THE CALLING SEQUENCE, PARAMETERS ARE PASSED TO * 05200016 * THIS ROUTINE BY MEANS OF A TWO FULL WORD PARAMETER LIST POINTED * 05400016 * TO BY REGISTER 1. THE FIRST FULL WORD CONTAINS AN ADDRESS SPECIFY-* 05600016 * ING WHICH POOL - BINARY ZERO FOR MESSAGE BLOCKS - AND ANY OTHER * 05800016 * NONZERO ADDRESS FOR JOB BLOCKS. THE SECOND FULL WORD CONTAINS AN * 06000016 * ADDRESS SPECIFYING THE OPERATION - BINARY ZERO IF A BLOCK IS TO BE 06200016 * RETRIEVED AND - THE ADDRESS OF THE BLOCK, IF IT IS BEING RETURNED.* 06400016 *INPUT * 06600016 * NO INPUT OTHER THAN THE PARAMETERS DESCRIBED ABOVE. * 06800016 * * 07000016 *OUTPUT * 07200016 * A RETRIEVE REQUEST OR A RELEASE REQUEST HAS BEEN SERVICED. * 07400016 * * 07600016 *EXTERNAL ROUTINES * 07800016 * IHKCAOSR-OVERLOAD SAFETY ROUTINE. THIS ROUTINE IS ENTERED TO * 08000016 * CLEAR THE TERMINAL QUEUE OF A TERMINAL IN A STATE OF MALFUNCTION * 08200016 * AT THE SAME TIM E A BLOCK REQUEST FINDS AN EMPTY SUBPOOL. * 08400016 * IHKCCFP1-RJE FREEPOOL-THIS IS NOT AN EXECUTABLE MODULE. * 08600016 * HOWEVER, THE ACTUAL CORE SPACE USED AS A BUFFER POOL FROM WHICH * 08800016 * TO OBTAIN QUEUE ENTRY BLOCKS IS ASSEMBLED WITHIN THE EXTERNAL * 09000016 * FREEPOOL MODULE. THIS MODULE MUST BE LINKAGE EDITED WITH THE * 09200016 * FREEPOOL MANAGER. THIS SUPPLIES THE FREEPOOL MANAGER WITH THE * 09400016 * ADDRESSES OF THE LABELS IHKCCFP1,IHKCCFP2 FOUND IN THE FREEPOOL * 09600016 * MODULE. THESE LABELS IDENTIFY THE FIRST BYTE OF THE POOL CONTROL * 09800016 * LISTS (PCL) FOR EACH OF SUBPOOLS 1 AND 2, ALLOWING THE FREEPOOL * 10000016 * MANAGER TO ACCESS THESE CORE POOLS. * 10200016 * * 10400016 * IHKAADSP-RJE DISPATCHER. THIS ROUTINE IS ENTERED TO WAIT FOR * 10600016 * REPLENISHMENT OF BLOCKS WHEN A SUBPOOL IS EMPTY. IT IS ALSO * 10800016 * ENTERED IF A REQUEST FOR BLOCKS FROM A PARTICULAR SUBPOOL IS MADE * 11000016 * BY ONE SUBTASK FOLLOWING A REQUEST FOR THE SAME KIND OF BLOCKS BY * 11200016 * ANOTHER SUBTASK WHICH REQUIRES A WAIT EXIT TO THE DISPATCHER.THIS * 11400016 * SECOND TYPE OF ENTRY TO THE DISPATCHER IS A WAIT FOR THE GATE TO * 11600016 * THIS ROUTINE TO BE OPENED, AS OPPOSED TO A WAIT FOR BLOCKS. IT IS * 11800016 * TO BE NOTED THAT A CLOSED GATE TO ONE SUBPOOL DOES NOT PREVENT * 12000016 * THE SERVICING OF A REQUEST FOR BLOCKS FROM ANOTHER SUBPOOL, PRO- * 12200016 * VIDED THIS SUBPOOL IS NOT ALSO EMPTY. * 12400016 * * 12600016 *EXITS-NORMAL * 12800016 * AFTER A RETRIEVE REQUEST-UPON EXIT REGISTER 1 CONTAINS THE ADDRESS* 13000016 * OF THE QEB BEING SUPPLIED TO THE CALLING ROUTINE. * 13200016 * IN ANY EVENT REGISTER 15 CONTAINS A ZERO RETURN CODE. REGISTER 1 * 13400016 * IS CHANGED. * 13600016 *EXITS-ABNORMAL * 13800016 * WAIT FOR BLOCKS EXIT-EXIT TO THE DISPATCHER TO WAIT FOR BLOCKS * 14000016 * FROM A PARTICULAR SUBPOOL TO BE RETURNED. THE ECBS FOR SUCH AN * 14200016 * ENTRY TO THE DISPATCHER ARE CONTAINED IN AND POSTED BY THIS * 14400016 * ROUTINE. * 14600016 * WAIT FOR GATE EXIT-EXIT TO THE DISPATCHER TO WAIT FOR THE RELEASE * 14800016 * OF THIS ROUTINE BY ANOTHER SUBTASK. * 15000016 * * 15200016 * * 15400016 *TABLES/WORK AREAS * 15600016 * A SEPARATE SAVE AREA IS REQUIRED FOR WAITING ON BLOCKS FOR EACH * 15800016 * SUBPOOL. A 4 WORD DUMMY SAVE AREA IS REQUIRED FOR SAVE AREA * 16000016 * CHAINING ON ENQUEUE REQUESTS. THE THREE SAVE AREAS ARE * 16200016 * REQUIRED BECAUSE THIS ROUTINE MUST HAVE THE ABILITY TO * 16400016 * SIMULTANEOUSLY PERFORM THREE SEPARATE FUNCTIONS FOR AS MANY * 16600016 * SUBTASKS. * 16800016 * * 17000016 *ATTRIBUTES * 17200016 * THIS ROUTINE IS SERIALLY REUSABLE. THE NUMBER OF QEB IN A * 17400016 * IN A SUBPOOL MUST BE DETERMINED BY REASSEMBLY OF THIS MODULE * 17600016 * PRIOR TO SYSTEM STARTUP. A WAIT OCCURS * 17800016 * IN THIS ROUTINE WHEN A RETRIEVE REQUEST COINCIDES WITH AN * 18000016 * EMPTY SUBPOOL OR A CLOSED GATE TO A SUBPOOL. EITHER WAIT CONSISTS * 18200016 * OF AN EXIT TO THE DISPATCHER, AND IS NOT A HARD WAIT. * 18400016 * * 18600016 *NOTES * 18800016 * THE OPERATION OF THIS MODULE DOES NOT DEPEND UPON A PARTICULAR * 19000016 * INTERNAL REPRESENTATION OF THE EXTERNAL CHARACTER SET. * 19200016 * * 19400016 * THE ECB'S IN THE ECBLIST ARE EXPECTED TO BE CONSECUTIVE. * 19600016 * * 19800016 SPACE 20200016 ENTRY IHKCCECB 20400016 EXTRN IHKCCFP1,IHKCCFP2 20600016 EXTRN IHKCACOM 20800016 SPACE 21000016 * 21200016 * GENERAL REGISTER USAGES 21400016 * 21600016 R15 EQU 15 ENTRY POINT AND RETURN CODE REGISTER 21800016 R14 EQU 14 RETURN POINT REGISTER 22000016 R13 EQU 13 SAVE AREA REGISTER 22200016 R12 EQU 12 NOT USED A37764 22300021 BASE EQU 12 BASE REGISTER FOR PROGRAM 22400016 R10 EQU 10 UTILITY REGISTER 22600016 TEMP EQU 9 UTILITY REGISTER 22800016 BUSYREG EQU 8 REGISTER FOR ADDRESSING BUSY FLAG 23000016 ECBREG EQU 7 REGISTER FOR POSTING ECB OF A 23200016 * SUBTASK WAITING FOR BLOCKS FROM A 23400016 * PARTICULAR SUBPOOL AT THE TIME SOME 23600016 * OTHERSUBTASK FREES SUCH A BLOCK. 23800016 R6 EQU 6 UTILITY REGISTER 24000016 R5 EQU 5 UTILITY REGISTER 24200016 R4 EQU 4 UTILITY REGISTER 24400016 R3 EQU 3 ADDRESS OF IHKCACOM 24600016 LIST EQU 2 SUBPOOL LIST ADDRESS REGISTER 24800016 R1 EQU 1 PARAMETER REGISTER AT ENTRY AND EXIT 25000016 R0 EQU 0 PARAMETER REGISTER AT ENTRY 25200016 STPRJE EQU B'10000000' 25400016 OFF EQU 0 25600016 STPRJEND EQU X'08' RJENDSWITCH-DEQ MSGS ONLY 25800016 CNTU EQU B'01100000' USED TO CHECK FOR CONTINUE 26000016 SPACE 3 26200016 IHKCCPLM CSECT 26400016 * 26600016 * PRELIMINARY MANIPULATIONS 26800016 * 27000016 SAVE (14,12),,11/8/IHKCCPLM 27200016 BALR BASE,0 ESTABLISH ADDRESSIBILITY USING 27400016 USING *,BASE REGISTER 12 AS BASE 27600016 SPACE 3 27800016 USING IHKZZCVT,R3 COMMUNICATIONS REGION 28000016 L R3,PARMLIST ADDRESS OF COMMUNICATION REGION 28200016 *** **** 28400016 * THE TYPE OF QUEUE ENTRY BLOCK TO CHANGE HANDS WILL NOW BE DETERMINED 28600016 *** **** 28800016 SPACE 29000016 L R4,0(R1) 29200016 LTR R4,R4 TEST TO DETERMINE WHICH POOL. 29400016 BNZ SMALL BRANCH IF JOB BLOCK DESIRED. 29600016 * IF THE BRANCH IS NOT TAKEN, A 29800016 * QUEUE ENTRY BLOCK FOR A SYSTEM 30000016 * MESSAGE IS DESIRED. 30200016 SPACE 30400016 L LIST,SUBPOOL1 LOAD LIST REGISTER WITH THE ADDRESS 30600016 * OF THE LIST FOR SUBPOOL 1 OF THE 30800016 * FREEPOOL. 31000016 LA TEMP,MYSAVE1 SET UP SAVE AREA REGISTER. 31200016 LA ECBREG,MSGECB ESTABLISH ADDRESSIBILITY FOR THE 31400016 LA BUSYREG,BUSYBYTM MESSAGE POOL EVENT CONTROL BLOCK 31600016 * AND BUSY FLAG. 31800016 SPACE 32000016 *** **** 32200016 * IT WILL NOW BE DETERMINED WHETHER A BLOCK IS BEING REQUESTED FROM A 32400016 * SUBPOOL, OR BEING RETURNED TO A SUBPOOL. 32600016 *** **** 32800016 SPACE 33000016 TEST L R1,4(R1) GET OPERATION INDICATOR 33200016 LTR R1,R1 TEST OPERATION INDICATOR 33400016 BNZ ADDEL BRANCH IF REGISTER 1 IS NOT 33600016 * ZERO TO ADD A BLOCK TO A SUBPOOL. 33800016 SPACE 34000016 *** *** 34200016 * A BLOCK IS TO BE REMOVED FROM A SUBPOOL, IF ONE IS AVAILABLE. 34400016 * THE BUSY FLAG FOR THIS SUBPOOL MUST BE TESTED TO SEE IF ANOTHER * 34600016 * SUBTASK IS ALREADY WAITING FOR BLOCKS FROM THIS SUBPOOL. * 34800016 *** *** 35000016 SPACE 35200016 TS 0(BUSYREG) TEST BUSY FLAG AND SET IF NOT SET. 35400016 BC 7,GATE BRANCH IF GATE IS CLOSED. 35600016 ST R13,4(TEMP) CHAIN THE SAVE AREAS AND 35800016 ST TEMP,8(R13) SET POINTER TO MY SAVE AREA IN 36000016 LR R13,TEMP REGISTER 13. 36200016 WAITRET LH R5,4(LIST) 000A 36400016 LTR R5,R5 TEST SUBPOOL LIST BLOCK COUNT 000A 36600016 BZ WAIT BRANCH TO WAIT IF SUBPOOL IS EMPTY. 36800016 SPACE 37000016 *** **** 37200016 * A BLOCK IS NOW AVAILABLE IN THE SUBPOOL AND CAN BE REMOVED. 37400016 *** **** 37600016 SPACE 37800016 REMFEL L R1,0(LIST) PLACE ADDRESS OF BLOCK TO BE REMOVED 38000016 * IN REGISTER 1. 38200016 MVC 0(4,LIST),0(R1) CHANGE THE POINTERS 38400016 LH R10,4(LIST) GET BLOCK COUNT 8207 38600000 BCTR R10,R0 DECREMENT THE COUNT OF THE 8207 38800000 STH R10,4(LIST) BLOCKS KEPT IN THE SUBPOOL LIST 8207 39000000 TM STPSW,STPRJE CHECK TO SEE IF THIS BLOCK IS 39400016 * BEING REMOVED TO BE USED AS A 39600016 * DUMMY QEB 39800016 BO ENQDUM BRANCH IF THIS IS THE CASE 40000016 SPACE 40200016 NI 0(BUSYREG),X'0' TURN OFF BUSY FLAG FOR THIS SUBPOOL. 40400016 SPACE 40600016 SPACE 40800016 RETURN L R13,4(R13) MAKE SURE CONTENTS OF REGISTER 1 * 41000016 ST R1,24(R13) GO BACK TO CALLER 41200016 RETURN (14,12),T,RC=0 SET ZERO RETURN CODE. 41400016 SPACE 41600016 SMALL L LIST,SUBPOOL2 LOAD LIST REGISTER WITH THE ADDRESS 41800016 * OF THE LIST OF SUBPOOL 2 OF THE 42000016 * FREEPOOL. 42200016 LA TEMP,MYSAVE2 SET UP SAVE AREA REGISTER. 42400016 LA ECBREG,JOBECB ESTABLISH ADDRESSIBILITY FOR THE 42600016 LA BUSYREG,BUSYBYTJ JOB POOL EVENT CONTROL BLOCK AND 42800016 * BUSY FLAG. 43000016 B TEST BRANCH TO TEST 43200016 SPACE 43400016 *** **** 43600016 * A BLOCK IS TO BE ADDED TO A SUBPOOL. 43800016 *** **** 44000016 SPACE 44200016 ADDEL ST R13,MYSAVE+4 CHAIN THE SAVE AREAS OF 44400016 LA TEMP,MYSAVE CALLING AND CALLED ROUTINE 44600016 ST TEMP,8(R13) TOGETHER. 44800016 LR R13,TEMP 45000016 L LIST,SUBPOOL1 LOAD MSG SUBPOOL A29512 45030020 TM 0(R1),X'80' TEST IF MSG QEB A29512 45060020 BO USEIT YES USE MSG SUBPOOL A29512 45090020 L LIST,SUBPOOL2 LOAD JOB SUBPOOL A29512 45120020 USEIT EQU * A29512 45150020 MVC 0(4,R1),0(LIST) ADD THE BLOCK POINTED TO BY REGISTER 45200016 MVI 0(R1),OFF SET INDICATOR FLAG OFF A32860 45300020 ST R1,0(LIST) 1 TO THE SUBPOOL BY CHANGING THE 45400016 * LIST AND BLOCK LINK POINTERS 45600016 LA LIST,4(LIST) 45800016 LH R6,0(LIST) INCREMENT THE COUNT OF 46000016 LA R5,1 THE NUMBER OF BLOCKS IN THE 46200016 AR R6,R5 SUBPOOL KEPT IN 46400016 STH R6,0(LIST) THE SUBPOOL LIST 46600016 OI 0(ECBREG),X'40' POST THE ECB OF ANY SUBTASK WAITING 46800016 * FOR THE BLOCK JUST RELEASED. 47000016 B RETURN BRANCH TO RETURN 47200016 WAIT L R4,TDIRBGN GET ADDRESS OF TERMINAL DIRECTORY 47400016 USING TDIREC,R4 ESTABLISH ADDRESSIBILITY OF DUMY 47600016 * CONTROL SECTION MAP 47800016 L R5,TDIRLGTH GET LENGTH OF A TERMINAL 48000016 LH R5,0(R5) DIRECTORY ENTRY. 48200016 L R6,TDIRNUMB GET NUMBER OF ENTRIES IN THE 48400016 LH R6,0(R6) TERMINAL DIRECTORY. 48600016 SR TEMP,TEMP ZERO OUT TEMP A37779 48800021 BCTR TEMP,R0 SET TEMP TO -1 A37779 49000021 SPACE 49200016 *** *** 49400016 * A SEARCH FOR TERMINALS HAVING A MECHANICAL FAILURE IS TO BE MADE. * 49600016 *** *** 49800016 SPACE 50000016 LOOP BXLE R6,TEMP,OUT SEARCH LOOP-BRANCH IF DIRECTORY END. 50200016 MVI STPSW,OFF INITIALIZE INTERNAL STOP SWITCH 50400016 MORE TM TDIRSTAT,X'04' TEST FOR MECHANICAL FAILURE. 50600016 BO SAFETY BRANCH IF DEQUEUE NOTHING BIT SET. 50800016 TM TDIRSTAT,STPRJEND CHECK FOR RJEND RECEIVED BY C/E 51000016 BO STOP BRANCH IF RECEIVED 51200016 TM TDIRSWCH+1,X'80' CHECK FOR DISCONTINUE 51400016 BO DISCONTU CHECK FOR CONTINUE 51600016 L R1,IHKZZRCS ADDRESS OF STOP SWITCH 51800016 TM 0(R1),X'08' TEST READER WARMSTART SWITCH 52000016 BO SAFETY BRANCH IF ON 52200016 TM 0(R1),STPRJE CHECK FOR STOP RJE SITUATION 52400016 BZ INACTIVE BRANCH IF NOT STOP SITUATION 52600016 STOP EQU * 52800016 OI STPSW,STPRJE TURN ON INTERNAL STOP SWITCH 53000016 B SAFETY 53200016 SPACE 53400016 INACTIVE AR R4,R5 UPDATE TO NEXT ENTRY. 53600016 B LOOP LOOP BACK. 53800016 SPACE 3 54000016 *TERMINAL IS DISCONTINUED, CHECK FOR CONTINUE RECEIVED. IF RECEIVED, 54200016 *IGNORE THE DISCONTINUE AND CONTINUE SEARCH THROUGH TERMINAL DIRECTORY. 54400016 SPACE 54600016 DISCONTU EQU * 54800016 TM TDIRSWCH+1,CNTU CHECK FOR CONTINUE 55000016 BNZ INACTIVE BRANCH IF CONTINUE RECEIVED 55200016 SPACE 55400016 SAFETY EQU * 55600016 CLC TDIRFQEB+1(3),ZERO TEST FOR EMPTY QUEUE. 55800016 BE INACTIVE BRANCH IF EMPTY QUEUE. 56000016 SPACE 56200016 *** *** 56400016 * A MALFUNCTIONING TERMINAL WITH A NONEMPTY QUEUE HAS BEEN FOUND. THE* 56600016 * OVERLOAD SAFETY ROUTINE IS CALLED TO CLEAR THIS QUEUE. * 56800016 *** *** 57000016 LOAD EP=IHKCAOSR 57200016 L R1,PARMLIST ADDRESS OF PARAMETER LIST-IHKCACOM 57400016 ST R4,0(R1) SET UP PARM LIST. 57600016 LR R15,R0 LOAD ENTRY POINT 57800016 BALR R14,R15 BRANCH TO ROUTINE 58000016 DELETE EP=IHKCAOSR 58200016 SPACE 3 58400016 *CHECK TO MAKE SURE THERE ARE QEBS AVAILABLE NOW 58600016 SPACE 58800016 RETEST EQU * 59000016 LH R10,4(LIST) 59200016 LTR R10,R10 TEST FOR EMPTY SUBPOOL. 59400016 BNZ REMFEL BRANCH IF NOT EMPTY. 59600016 B INACTIVE TRY NEXT ENTRY IN THE TDIR 8207 59800000 SPACE 3 60000016 *THE QEBS WERE DEPLETED WHILE THE C/E WAS WAITING FOR A STOP COMMAND TO 60200016 *BE PROCESSED. THE QEBS HAVE BEEN CLEARED FROM THE FIRST TERMINAL 60400016 *HAVING ANYTHING ENQUEUED. NOW A DUMMY QEB WILL BE ENQUEUED SO THAT 60600016 *LINE ANALYSIS WRITE WILL SEND ALL MESSAGES TO THE TERMINAL BEFORE 60800016 *CLOSING DOWN. 61000016 SPACE 61200016 ENQDUM EQU * 61400016 MVI STPSW,OFF TURN OFF INTERNAL STOP SWITCH 61600016 MVI 0(R1),DUMQEB INDICATE TYPE OF QEB 61800016 ST R4,QMGTDIR TERMINAL WHERE QEB IS TO BE ENQUEUED 62000016 ST R1,QMGQEB ADDRESS OF QEB 62200016 LA R1,QMGPARM ADDRESS OF PARAMETER LIST 62400016 L R15,IHKZZQMG ADDRESS OF Q-MGR 62600016 BALR R14,R15 ENQUEUE DUMMY QEB 62800016 B RETEST GO CHECK TO SEE IF THERE ARE STILL 63000016 * QEBS AVAILABLE 63200016 SPACE 63400016 *** *** 63600016 * THE POOL IS EMPTY AND NO TERMINAL HAVING A MECHANICAL FAILURE HAS * 63800016 * BLOCKS FROM THIS POOL ON ITS QUEUE. THE DISPATCHER MUST BE ENTERED * 64000016 * TO WAIT FOR BLOCKS TO BE RETURNED TO THIS SUBPOOL. * 64200016 *** *** 64400016 SPACE 64600016 OUT EQU * A37764 64700021 MVI STPSW,OFF TURN OFF STOP SWITCH A37779 64800021 LA R15,WAITRET SET RETURN ADDRESS A58978 64900021 STM R14,R12,12(R13) STORE REGS FOR RETURN TO A37764 65000021 * WAITRET A58978 65100021 * 66200016 SPACE 66400016 *** *** 66600016 * THE DISPATCHER IS TO BE ENTERED BECAUSE THE BUSY FLAG WAS SET. * 66800016 *** *** 67000016 SPACE 67200016 GATE SR R14,R14 SET REGISTERS FOR SPECIAL ENTRY 67400016 L R15,AADSP TO THE DISPATCHER 67600016 BR R15 AND EXIT. 67800016 * PROGRAM SECTION FOR SAVE AREA,WORKING STORAGE, AND CONSTANTS . 68000016 * 68200016 SPACE 68400016 SUBPOOL1 DC A(IHKCCFP1) ADDRESSES OF THE SUBPOOL LISTS FOR 68600016 SUBPOOL2 DC A(IHKCCFP2) SUBPOOLS 1 AND 2 OF THE FREEPOOL. 68800016 SPACE 3 69000016 *ECB LIST-BOTH ECB'S ARE POSTED COMPLETE EVERY TIME THERE IS A LINE 69200016 *FAILURE OR A DISCONTINUE. IF THE POOL MGR IS WAITING IN THE DISPATCHER 69400016 *FOR A QEB TO FREED UP, IT WILL RECEIVE CONTROL,CHECK THE BITS 69600016 *(TDIRSTAT,X'04' AND TDIRSWCH+1,X'80'),FREE THE QEB'S AND CONTINUE 69800016 *PROCESSING. IF THE POOL MGR IS NOT WAITING,THE POSTING WILL HAVE NO 70000016 *EFFECT. 70200016 SPACE 70400016 IHKCCECB DS 0F 70600016 MSGECB DC F'0' ECB FOR SUBTASKS WAITING FOR 70800016 * MESSAGE BLOCKS. 71000016 JOBECB DC F'0' ECB FOR JOB BLOCKS SUBPOOL. 71200016 BUSYBYTM DC X'00' BUSY FLAG FOR MESSAGE SUBPOOL. 71400016 BUSYBYTJ DC X'00' BUSYFLAG FOR JOB BLOCKS. A HEX 80 71600016 DUMQEB EQU X'84' 71800016 * IS MOVED INTO A BUSY FLAG TO 72000016 * INDICATE A WAIT CONDITION. OTHERWISE 72200016 * IT IS BINARY ZERO. 72400016 SPACE 72600016 STPSW DC X'0' INTERNAL STOP SWITCH 72800016 SPACE 73000016 MYSAVE1 DS 18F SAVE AREA FOR SUBPOOL1. 73200016 MYSAVE2 DS 18F SAVE AREA FOR SUBPOOL2. 73400016 MYSAVE DS 4F DUMMY SAVE AREA FOR CHAININF ON 73600016 * ENQUEUE REQUESTS. 73800016 SPACE 74000016 SPACE 74200016 PARMLIST DC A(IHKCACOM) ADDRESS OF PARAMETER LIST 74400016 ZERO DC F'0' BINARY ZERO 74600016 SPACE 3 74800016 *PARAMETER LIST FOR Q-MGR TO ENQUEUE DUMMY QEB 75000016 SPACE 75200016 QMGPARM DS 0F 75400016 QMGTDIR DC F