./ ADD SSI=09010513,NAME=IBCDASDI,SOURCE=0 PRINT OFF 00000300 REPRO 00000721 0@@ &@ DASDI - DUMP/RESTORE 00001421 REPRO 00002121 @ &@ &@Q &'&0ؗ-}&1&&ɺ0--0ӆ 0ɺ00002821 REPRO 00003521 0-0φ 0nS10nL10nX1-0 1ه1 1 000Ӈ100004221 REPRO 00004921 07}&0&*b1nN1-0 -}b}1 &1͠^0&11 00005621 REPRO 00006321 ^0n,000ӄnF0ɹnF0i1ɡ00007021 REPRO 00007721 1 0'<&C 00008421 PRINT ON 00009221 ENTER START 0 00010020 ORG ENTER 00020020 TITLE 'DASDI-IBCDASDI PACK INITIALIZATION' 00030000 * * 00040020 *STATUS -CHANGE LEVEL 7.7 -- OS REL 21.7 -- 8/24/72 * 00050000 * * 00060020 *FUNCTION/OPERATION- EITHER INITIALIZES A DIRECT ACCESS VOLUME TO * 00070020 * CONFORM TO OS/360 SPECIFICATIONS OR OBTAINS ALTERNATE TRACKS * 00080020 * FOR SPECIFIED DEFECTIVE TRACKS ON A PREVIOUSLY INITIALIZED * 00090020 * VOLUME. * 00100020 * * 00110020 * INITIALIZING A DIRECT ACCESS VOLUME CONSISTS OF THE FOLLOWING- * 00120020 * DETECTING DEFECTIVE TRACKS, ASSIGNING ALTERNATES FOR DEFECTIVE * 00130020 * PRIMARY TRACKS ON DISK STORAGE, WRITING THE STANDARD HOME ADD- * 00140020 * RESS AND RECORD ZERO ON EACH TRACK, FORMATING OF TRACK ZERO, * 00150020 * WRITING A STANDARD VOLUME TABLE OF CONTENTS, AND OPTIONALLY * 00160020 * WRITING AN IPL PROGRAM. * 00170020 * * 00180020 * OBTAINING AN ALTERNATE TRACK FOR A SPECIFIED DEFECTIVE TRACK ON * 00190020 * DISK STORAGE CONSISTS OF THE FOLLOWING- * 00200020 * SELECTING THE FIRST AVAILABLE ALTERNATE AS SPECIFIED IN THE VTOC, * 00210020 * CHAIN THE ALTERNATE TRACK TO THE DEFECTIVE PRIMARY AND THE * 00220020 * DEFECTIVE PRIMARY TO THE ALTERNATE, AND UPDATE THE VTOC TO * 00230020 * INDICATE THE NUMBER OF ALTERNATE TRACKS STILL AVAILABLE. * 00240020 * * 00250020 *ENTRY POINTS- CONTROL IS GIVEN TO LOCATION -START- BY THE ABSOLUTE * 00260020 * LOADER, WHICH CONSTITUTES THE FIRST PART OF THE PROGRAM. CONTROL * 00270020 * CARDS ARE READ AND ANALYSED TO DETERMINE IF THE INITIALIZATION * 00280020 * OR THE GET-AN-ALTERNATE TRACK FUNCTION IS TO BE EXECUTED. THE * 00290020 * INITIALIZATION ROUTINE IS ENTERED AT -VOLCHK- IF THE VOLUME * 00300020 * LABEL IS TO BE CHECKED, OTHERWISE AT LOCATION -GEN5E-. THE * 00310020 * GETALT FUNCTION IS ENTERED AT LOCATION -GETALTY2-. * 00320020 * * 00330020 *INPUT- CONTROL STATEMENTS,AVAILABLE DIRECT ACCESS VOLUME. * 00340020 * * 00350020 *OUTPUT- THE DIRECT ACCESS VOLUME WILL EITHER BE INITIALIZED OR HAVE * 00360020 * ALTERNATE TRACKS ASSIGNED AS DESCRIBED UNDER THE ABOVE HEADING, * 00370020 * FUNCTION/OPERATION. APPROPIATE MESSAGES WILL BE GIVEN TO THE * 00380020 * OPERATOR DESCRIBING THE STATUS OF THE DIRECT ACCESS VOLUME. * 00390020 * * 00400020 *EXITS-NORMAL- SUCCESSFUL COMPLETION OF DASDI RESULTS IN A WAIT PSW * 00410020 * WITH E'S IN THE ADDRESS FIELD FOR DISPLAY IN THE CONSOLE LIGHTS. * 00420020 * AN END OF JOB MESSAGE IS ALSO GIVEN ON THE MESSAGE DEVICE. * 00430020 * * 00440020 *EXITS-ERROR- A WAIT PSW IS LOADED WITH E'S IN THE ADDRESS FIELD * 00450020 * FOR DISPLAY IN THE CONSOLE LIGHTS. ERROR STOPS, WHENEVER * 00460020 * POSSIBLE, ARE PRECEDED BY A MESSAGE WHICH DEFINES THE ERROR. * 00470020 * THE MESSAGE IS GIVEN ON THE MESSAGE DEVICE OR OPERATORS CONSOLE. * 00480020 * MACHINE CHECK INTERRUPTS RESULT IN THE LOADING OF A PSW IN THE * 00490020 * WAIT STATE WITH E2 IN THE ADDRESS FIELD FOR DISPLAY IN THE * 00500020 * CONSOLE LIGHTS. CONSTANTS ARE SET UP FOR THE RUNNING OF THE * 00510020 * SEREP PROGRAM AFTER DASDI HALTS ON MACHINE CHECK OR I/O DEVICE * 00520020 * MALFUNCTION. * 00530020 * * 00540020 *EXTERNAL ROUTINES- DASDI REQUIRES SOME INFORMATION FROM THE * 00550020 * OPERATOR AS TO THE LOCATION OF THE TYPEWRITER CONSOLE (IF ANY), * 00560020 * AND THE INPUT SOURCE FOR THE CONTROL STATEMENTS. ON INITIAL * 00570020 * LOADING OF DASDI, THE PROGRAM HALTS IN A WAIT STATE WITH F'S * 00580020 * DISPLAYED IN THE CONSOLE LIGHTS. IF A CONSOLE TYPEWRITER IS * 00590020 * AVAILABLE, THE OPERATOR DEPRESSES THE REQUEST KEY AND THIS * 00600020 * IDENTIFIES THE LOCATION OF THE TYPEWRITER TO DASDI AND A MESSAGE * 00610020 * IS GIVEN ASKING THE OPERATOR TO DEFINE THE INPUT DEVICE FOR * 00620020 * CONTROL STATEMENTS. THE OPERATOR THEN TYPES IN LOWER OR UPPER * 00630020 * CASE FOR EXAMPLE- * 00640020 * INPUT=1402 00C * 00650020 * WHICH TELLS DASDI TO GO TO A 1402 READER ON CUU 00C FOR CONTROL * 00660020 * CARDS. * 00670020 * IF A CONSOLE TYPEWRITER IS NOT AVAILABLE, THE OPERATOR ENTERS * 00680020 * INTO HEX LOCATIONS 0110 AND 0111, ONE OF THE FOLLOWING CODES- * 00690020 * XCUU WHERE X=0 FOR A 2540 READER, 1 FOR A 1402/1442 * 00700020 * READER, AND 2 FOR A 2400 NINE TRACK TAPE. CUU IS THE CHANNEL/ * 00710020 * UNIT ADDRESS OF THE INPUT DEVICE. * 00720020 * * 00730020 *TABLES/WORK AREAS * 00740020 * -OPRTAB- A LIST OF VALID COMMAND WORDS USED ON CONTROL CARDS. * 00750020 * -KEYTAB- A LIST OF VALID KEY WORDS USED ON CONTROL CARDS. * 00760020 * -SYINTAB-A LIST OF VALID INPUT DEVICES FOR CONTROL CARDS. * 00770020 * -DEVTAB- A LIST OF VALID DEVICES HANDLED BY DASDI. * 00780020 * -PROCBUFF- A LIST OF CONSTANTS FOR SPECIFIC DEVICE TYPES. * 00790020 * -CONVTAB-A TABLE USED TO CONVERT CONSOLE INPUT TO UPPER CASE. * 00800020 * -IOTAB- A TABLE USED TO CONVERT HEX TO EBCDIC GRAPHIC. * 00810020 * -ALTTT- A TABLE USED TO CONVERT EBCDIC GRAPHIC TO HEX. * 00820020 * -TAB13- A BUFFER OF HEX 00'S FOR DISK AND DRUM SURFACE ANALYSIS. * 00830020 * -TAB5E- A BUFFER OF HEX E5'S FOR DATA CELL SURFACE ANALYSIS. * 00840020 * -TAB5E- A BUFFER OF HEX 55'S FOR DISK AND DRUM SURFACE ANALYSIS. * 00850020 * * 00860020 *ATTRIBUTES- PRIVILEGED, DISABLED, NON-RELOCATABLE, SERIALLY-REUSABLE * 00870020 * EXCEPT FOR 2321 JOBS FOLLOWING NON-2321 JOBS. * 00880020 * CHARACTER DEPENDENT TABLES AT -CONVTAB- AND -ALTTT-. * 00890020 * * 00900020 EJECT 00910020 *309600-309600 A48568 00912000 *1355,001000,018300,019200-019400,066800,074000 7974 00920020 *1355,142900 7679 00930020 *2095566600 1095 00940020 *2095635200 1095 00950020 *2095639400 1095 00960020 * 310100 A43208 00962021 * 011800 A42861 00965021 * 001000,018400,018600,018800,019100,027000,034000,034200,047800,S20201 00970020 * 048000,049000,054400,056200,060200,060600,060800,062000,062600,S20201 00980020 * 063200,067000,071000,074000,089600,090200,106000,106800,108000,S20201 00990020 * 110000,110200,111200,111600,111800,112200,123600,123800,124000,S20201 01000020 * 124400,135800,137400,137800,138400,139000,139600,140200,140800,S20201 01010020 * 176000,176200,215600,216200,221400,221800,222000,222200,235600,S20201 01020020 * 241520,423000,423400,424800,425000,428600,428800,432400,434800,S20201 01030020 * 442200-442600,445600,467400,467800,471400,471600,473200,498450,S20201 01040020 * 543600,567000,599000,600000-601000,645800,646400,647200, S20201 01050020 * 668800-674400,674800-681400,682400,683600,692400,692600,693600,S20201 01060020 * 693800,694000-694400,694800,695600,697000,697800-698200,701600,S20201 01070020 * 703200,703600,705200,707800,778200,710800,721200,721600,722000,S20201 01080020 * 726400,745200,745400,745800,747200,747400,747600,761200,761400,S20201 01090020 * 761600,762400,763600,763800,766000,768600,778400,784400,784800,S20201 01100020 * 785400,790800,796000,819600,853000,880400,880600,882200,882600,S20201 01110020 * 883400,888600,890800,898200,899200,899400,921000,921200,923000,S20201 01120020 * 925600,927800,929800,959600,964000 S20201 01130020 * 372700,377600 M5714 01135020 * 360000,361400 M6371 01137020 *0988311200,314300 A46384 01137221 * 266600,267600,347100,347200,389200,396400 A43889 01137521 *0988125800-126100,133100,208630-208750 M0158 01138521 USING IPLPSW,BASE0,BASE10,11,12,13 S20201 01140020 USING TAB13,8 S20201 01150020 USING TAB5E,9 S20201 01160020 SPACE 1 01170020 IPLPSW DC XL2'0004' IPLPSW A42861 01180021 DS 2X DO NOT OVERLAY IPL'D DEVICE 7974 01190020 DC A(START) INITIAL ECS ENTRY POINT 7974 01200020 EJECT 01210020 * COMMON STORAGE AREAS USED BY ALL SECTIONS 01220020 SPACE 2 01230020 ORG ENTER+272 01240020 INPUTDEV DC X'BAD0000000000000' 01250020 SPACE 2 01260020 * GENERAL PURPOSE REGISTER SAVE AREAS 01270020 SPACE 2 01280020 REGSV1 DC 2F'0' SCAN REG SAVE AREA 01290020 REGSV DC 16F'0' USED BY INTERRUPT SUPERVISORS. 01300020 REGSV2 DC 16F'0' USED BY DATA INPUT ROUTINE 01310020 REGSV3 DC 16F'0' USED BY BLANK TRACK PRINTOUT. 01320020 REGSV4 DC 16F'0' USED BY MESSAGE OUTPUT ROUTINE 01330020 REGSV5 DC 16F'0' USED BY I/O CONTROL ROUTINE 01340020 REGSV6 DC 16F'0' USED BY WRITE TO OPERATOR 01350020 REGSV7 DC 16F'0' USED BY ERROR MSG PRINT 01360020 REGSV8 DC 16F'0' USED BY FORMAT VTOC ROUTINE 01370020 ERRSAV1 DC 16F'0' USED BY TAPE ERROR ROUTINES. 01380020 EJECT 01390020 * ********************************************** 01400020 * * UNIT CONTROL BLOCK * 01410020 * ********************************************** 01420020 * * * 01430020 * * BYTE FUNCTION * 01440020 * * 00 UNIT REFERENCE NUMBER * 01450020 * * 01 UNUSED * 01460020 * * 02-03 CHANNEL AND UNIT NUMBER 01470020 * * 04 CAW PROTECT * 01480020 * * 05-07 CAW * 01490020 * * 08-15 INTERRUPT PSW * 01500020 * * 16-23 INTERRUPT CSW * 01510020 * * 24-31 SENSE INFORMATION * 01520020 * * 32-48 3330,2305 SENSE INFO * 01530020 * ********************************************** 01540020 * 01550020 SPACE 2 01560020 UCBTAB DS 0D 01570020 SPACE 1 01580020 UCBTO DC XL48'00' TO DEVICE UCB S20201 01590020 SPACE 1 01600020 UCBSYI DC XL32'00' INPUT UCB 01610020 SPACE 1 01620020 UCBSYO DC XL32'00' MESSAGE OUTPUT UCB 01630020 SPACE 1 01640020 UCBOPR DC XL32'00' OPERATOR OUTPUT UCB 01650020 SPACE 1 01660020 EJECT 01670020 SWITCHRD DS 19D SCAN WORK AREA 01680020 SETUPPSW DC X'01040000' NEW EXTERNAL INTERRUPT PSW 01690020 DC A(EXTINT) 01700020 DC X'01040000' NEW SUPERVISOR CALL PSW 01710020 DC A(SVCINT) 01720020 DC X'01040000' NEW PROGRAM INTERRUPT PSW 01730020 DC A(PGMINT) 01740020 DC X'00020000' NEW MACHINE CHECK PSW 01750020 DC X'000000E2' 01760020 DC X'01040000' NEW INPUT/OUTPUT PSW 01770020 DC A(CKCSW) 01780020 CVBCOM DS 1D CVB WORK AREA 01790020 CLEAR DC D'0' EIGHT BYTES OF ZEROS 01800020 SARG DS 1D SEARCH ARGUMENT 01810020 KEYSEQ DC XL8'00' PARAMETER INDICATOR BYTE 01820020 TRACKA DC F'0' 01830020 TRACKADR DC F'0' 01840020 SYOMDL DC XL4'0' 01850020 SYODEV DC XL4'0' 01860020 SYIMDL DC XL4'0' 01870020 SYIDEV DC XL4'0' 01880020 TOMDL DC XL4'0' 01890020 TODEV DC XL4'0' 01900020 VTOCBGN DC F'0' 01910020 DC H'0' ALLOW FOR PROCESSING STRTADR1095 01920020 VTOCEND DC F'0' 01930020 SAVLGTH DC XL4'00' SCAN LENGTH REG SAVE AREA 01940020 VTOCENDX DC 3H'0' 01950020 VOLCHKSW DC X'0000' VOL LABEL CHK BYPASS SWITCH 01960020 ALTSW DC X'00' TEST AVAIL-ALT FOR 3330 S20201 01970020 FLGDRUM DC X'00' DRUM DEVICE INDICATOR S20201 01972021 * 01=2301 01990020 * 02=2303 02000020 * 04=2305 02010020 * 08=2305 W/ALT ASSIGNED 02020020 * 20=MODEL PARAMETER READ 02030020 SEQSW DC X'00' CTL STM SEQUENCE INDICATOR SW 02040020 JOBSW DC X'00' TELL IF JOB STMNT HAS BEEN READ 02050020 SPIOSW DC X'00' 02060020 NORCDSW DC X'00' NO RECORD FOUND SWITCH 02070020 ENTRYTWO DC X'00' SURFACE CHK ERROR COUNTER 02080020 IPLSW DC X'00' IPL REQUEST SWITCH 02090020 CHANSAV DC X'00' CHANNEL NUMBER SAVE AREA 02100020 CHCKAREA DC X'00' DEVICE CHECK SAVE AREA. 02110020 DSCBSW DC X'00' 02120020 GTALTSW DC X'00' GETALT FUNCTION SWITCH - FF - ON 02130020 VTOCSW DC X'00' WRITE VTOC SW 02140020 TEXTSW DC X'00' 02150020 ALTALTSW DC X'00' GET ALT FOR ALT 02160020 BINSW DC X'00' 02170020 ACTXIISW DC X'00' 02180020 ERR906SW DC X'00' 2321 BAD HA/R0 02190020 BYPASS DC X'00' 'FF' MEANS SKIP ANALYSIS. 02200020 ERASESW DC X'00' 'FF' MEANS DATA CHECK 2321 ERASE 02210020 SPAREX DC X'000000' 02220020 YEA DC C'YES' 02230020 DATE DC C'06/06/67' RELEASE 13 LEVEL. 02240020 EDJTSW DC X'00' TELL END OF TASK 02250020 REQSW DC X'00' 1ST TIME SWITCH FOR REQUEST 7974 02260020 BLANK DC 6C' ' SIX BYTES OF BLANKS 02270020 EJECT 02280020 SPACE 2 02290020 * PSW AREAS 02300020 SPACE 2 02310020 SVPSW DS 1D USED BY INTERRUPT SUPERVISORS 02320020 SPACE 1 02330020 COWAIT DC X'00060000' TERMINATE WAIT STATE. 02340020 DC X'0000EEEE' 02350020 SPACE 1 02360020 WAITNO1 DC X'FF060000' WAIT PSW FOR OPR SYSIN INSERT 02370020 DC X'0000FFFF' 02380020 SPACE 1 02390020 CONTINUE DC X'01040000' CONSOLE INTRPT RETURN PSW 02400020 DC A(CKINPUT) 02410020 SPACE 1 02420020 IOWAIT DC X'01060000' I/O WAIT AND RETRY PSW 02430020 DC X'00001111' 02440020 SPACE 1 02450020 ENIOPSW DC X'0104000000' 02460020 DC AL3(CKIOINT) 02470020 SPACE 1 02480020 ACKCSW1 DC X'0104000000' UNSOLISITED SELECTOR RETURNS. 02490020 DC AL3(CKCSW1) 02500020 * 02510020 * COMMON CONSTANTS 02520020 * 02530020 DS 0F 02540020 SYSBAS DC X'00001000' ****TEMPORARY 02550020 DC X'00002000' 02560020 DC X'00003000' 02570020 VTCBAS DC X'00004000' 02580020 ADRD2321 DC A(MFRANAL) ADDRESS READ BACK CCWS--2321. 02590020 ERRORMSG DC A(ERRMSG) ADDRESS OF ERROR MESSAGE TABLE. 02600020 EJECT 02610020 * SYSTEM REGISTER DESIGNATIONS 02620020 * 02630020 GR1 EQU 1 02640020 GR2 EQU 2 02650020 GR3 EQU 3 02660020 GR4 EQU 4 02670020 GR5 EQU 5 02680020 GR7 EQU 7 02690020 GR8 EQU 8 BASE FOR TAB13,2321 S20201 02700020 GR15 EQU 15 02710020 REG1 EQU 1 02720020 REG14 EQU 14 02730020 GR6 EQU 6 02740020 GR9 EQU 9 BASE FOR TAB5E S20201 02750020 GR14 EQU 14 02760020 CSR0 EQU 0 02770020 CSR1 EQU 1 02780020 CSR2 EQU 2 02790020 CSR3 EQU 3 02800020 CSR4 EQU 4 02810020 CSR5 EQU 5 02820020 REGC EQU 3 02830020 REGD EQU 4 REGD AND REGE MUST BE EVEN ODD 02840020 REGE EQU 5 02850020 REGF EQU 6 02860020 REGG EQU 7 02870020 REGH EQU 8 02880020 WORK4 EQU 4 02890020 ERREG1 EQU 1 02900020 ERREG3 EQU 3 02910020 ERREG4 EQU 4 02920020 BASE0 EQU 0 BASE REGESTER ZERO 02930020 BASE10 EQU 10 SYSTEM BASE REG 02940020 BASE12 EQU 12 02950020 BASE13 EQU 13 S20201 02960020 SCANADR EQU 1 SCAN ADR POINTER 02970020 LENGTH EQU 2 SCAN LENGTH REGISTER 02980020 UCBREG EQU 2 POINTER TO UCB 02990020 CCWREG EQU 3 03000020 IOLOOP EQU 4 03010020 SCANREG EQU 8 03020020 LINK5 EQU 5 LINK REGISTER 03030020 ERRLNK EQU 9 * 03040020 LINK9 EQU 9 LINK REQISTER 03050020 LINK14 EQU 14 LINK REG FOR SCAN ROUTINE 03060020 LINK EQU 15 LINKAGE REGISTER 03070020 LINK15 EQU 15 03080020 EJECT 03090020 * *************************************************** 03100020 * * EQUATES FOR STANDARDS * 03110020 * *************************************************** 03120020 R0 EQU 0 REGISTER 0 S20201 03130020 A27 EQU 27 LOCATION 27 S20201 03140020 H40 EQU X'40' HEX 40 S20201 03150020 L16 EQU 16 LENGTH OF 16 S20201 03160020 K1 EQU 1 CONSTANT OF 1 S20201 03170020 H07 EQU X'07' INCREMENT VALUE S20201 03180020 K3 EQU 3 CONSTANT OF 3 S20201 03190020 TEN EQU X'10' ENV DATA BIT S20201 03200020 EIGHTY EQU X'80' BUFLOG FULL BIT S20201 03210020 H00 EQU X'00' HEX 00 S20201 03220020 H04 EQU X'04' HEX 04 S20201 03230020 L11 EQU 11 LENGTH OF 11 S20201 03240020 L2 EQU 2 LENGTH OF 2 S20201 03250020 L4 EQU 4 LENGTH OF 4 S20201 03260020 L0 EQU 0 VALUE OF ZERO S20201 03270020 L12 EQU 12 LENGTH OF 12 S20201 03280020 H24 EQU X'24' HEX 24 S20201 03290020 H01 EQU X'01' HEX 01 S20201 03300020 L8 EQU 8 LENGTH OF 8 S20201 03310020 K6 EQU 6 CONSTANT OF 6 S20201 03320020 H02 EQU X'02' VALUE OF HEX 02 S20201 03330020 H20 EQU X'20' VALUE OF HEX 20 S20201 03340020 TWO56 EQU 256 VALUE OF 256 S20201 03350020 X05 EQU X'05' HEX 05 CONSTANT S20201 03360020 CHARC EQU C'C' CHARACTER C S20201 03370020 CHARA EQU C'A' CHARACTER A S20201 03380020 CHAR1 EQU C'1' CHARACTER 1 S20201 03390020 CHAR2 EQU C'2' CHARACTER 2 S20201 03400020 TWOSIX EQU 26 LENGTH OF 26 S20201 03410020 L6 EQU 6 LENGTH OF 6 S20201 03420020 L10 EQU 10 LENGTH OF 10 S20201 03430020 L32 EQU 32 LENGTH OF 32 S20201 03440020 L5 EQU 5 LENGTH OF 5 S20201 03450020 ONE11 EQU 111 LENGTH OF 111 S20201 03460020 K22 EQU 22 CONSTANT OF 22 S20201 03470020 L7 EQU 7 LENGTH OF 7 S20201 03480020 H08 EQU X'08' HEX 08 S20201 03490020 H0B EQU X'0B' HEX 0B S20201 03500020 H16 EQU X'16' HEX 16 S20201 03510020 L24 EQU 24 LENGTH OF 24 S20201 03520020 A114 EQU 114 LENGTH OF 114 S20201 03530020 A106 EQU 106 LENGTH OF 106 S20201 03540020 EJECT 03550020 * *************************************************** 03560020 * * EQUATES FOR STANDARDS * 03570020 * *************************************************** 03580020 L59 EQU 59 LENGTH OF 59 S20201 03590020 L40 EQU 40 LENGTH OF 40 S20201 03600020 L30 EQU 30 LENGTH OF 30 S20201 03610020 L56 EQU 56 LENGTH OF 56 S20201 03620020 L67 EQU 67 LENGTH OF 67 S20201 03630020 L240 EQU 240 CONSTANT OF 240 S20201 03640020 L9 EQU 9 CONSTANT OF 9 S20201 03650020 L50 EQU 50 CONSTANT OF 50 S20201 03660020 L45 EQU 45 CONSTANT OF 45 S20201 03670020 L36 EQU 36 CONSTANT OF 36 S20201 03680020 L38 EQU 38 CONSTANT OF 38 S20201 03690020 L15 EQU 15 CONSTANT OF 15 S20201 03700020 L22 EQU 22 CONSTANT OF 22 S20201 03710020 L31 EQU 31 CONSTANT OF 31 S20201 03720020 EJECT 03730020 START LM 0,15,REGSV CLEAR GENERAL REGS 03740020 LM BASE10,BASE13,SYSBAS ESTABLISH BASES S20201 03750020 MVC 88(40),SETUPPSW ESTABLISH DASDI PSWS. 03760020 MVI 50,X'FF' SET SEREP FALGS IN OLD MC PSW 03770020 MVI REQSW,X'00' TURN OFF REQUEST SWITCH 7974 03780020 LPSW WAITNO1 WAIT FOR SYSIN DEVICE DEFINITION 03790020 * 03800020 * SETUP SYSIN DEVICE FROM CONSOLE INPUT 03810020 * 03820020 CKINPUT TM INPUTDEV,X'F0' IS INPUT VIA READER 1402/2540 03830020 BC 8,IN1402 YES - PERFORM 1402 SETUP 03840020 MVZ CHCKAREA(1),INPUTDEV SETUP DEVICE TYPE CHECK 03850020 CLI CHCKAREA,X'10' IS SYSIN DEVICE A 1442 03860020 BC 8,IN1442 YES 03870020 CLI CHCKAREA,X'20' IS SYSIN DEVICE A 2400 03880020 BC 8,IN2400 YES 03890020 CLI CHCKAREA,X'30' IS SYSIN DEVICE A 1052 03900020 BC 8,IN1052 YES 03910020 CLI INPUTDEV,X'BA' WAS INTERRUPT KEY DEPRESSED. 03920020 BC 8,START YES--GO TO START UNTIL REQUEST. 03930020 B INPUTERR ILLEGAL INPUT DEVICE 03940020 * 03950020 IN1402 MVI UCBSYI,T1402 SYSIN UCB FOR 1402 S20201 03960020 INADR MVN CHANSAV(1),INPUTDEV ISOLATE CHANNEL NUMBER 03970020 MVC UCBSYI+2(2),INPUTDEV ENTER SYSIN C/U IN SYSIN UCB 03980020 NI UCBSYI+2,X'07' CLEAR DEVICE TYPE INDICATOR 03990020 MVC 120(8),ENIOPSW 04000020 B CLRSCAN 04010020 * 04020020 IN1442 MVI UCBSYI,T1442 SYSIN UCB FOR 1442 S20201 04030020 B INADR ENTER SYSIN C/U IN UCBSYI 04040020 * 04050020 IN2400 MVI UCBSYI,T2400 SYSIN UCB FOR 2400 S20201 04060020 B INADR 04070020 * 04080020 IN1052 MVI UCBSYI,T1052 SYSIN UCB FOR 1052 S20201 04090020 B INADR 04100020 * 04110020 * INPUT PARAMETER ERROR DISPLAY ROUTINE 04120020 * 04130020 INPUTERR MVC WAITNO1+6(2),INPUTDEV SET INTERFACE ADR FOR DISPLAY 04140020 MVZ WAITNO1+6(1),CON80 INSERT CODE 8 IN FIRST HALF BYTE 04150020 * INDICATES INPUT PARAMETER ERROR 04160020 LPSW WAITNO1 SET WAIT CODE IN COLSOLE LIGHTS 04170020 * 04180020 DS 0F 04190020 CON80 DC X'80' 04200020 ENABLE DC X'FF' I/O ENABLED 04210020 DISABLE DC X'01' I/O DISABLED 04220020 DS 0F 04230020 EJECT 04240020 * SETUP SYSIN DEVICE FROM TYPEWRITER INPUT 04250020 SPACE 2 04260020 ATTN TM REQSW,X'FF' IS THIS FIRST ATTN INTERUPT 7974 04270020 MVI REQSW,X'FF' TURN ON REQUEST SWITCH 7974 04280020 BZ ATTN1 YES THIS IS THE FIRST. 7974 04290020 LPSW 56 NOT THE FIRST. 7974 04300020 ATTN1 SSM ENABLE SET SYSTEM MASK ENABLE 7974 04310020 MVI UCBOPR,T1052 UCBOPR DEVICE TYPE S20201 04320020 MVC UCBOPR+2(2),58 INSERT C/U IN UCBOPR 04330020 LA GR1,41 LENGTH OF MESSAGE. 04340000 LA CSR2,OPRMSG MESSAGE PRINT WORD TO OPERATOR 04350020 BAL LINK15,OPPRNT CALL W T O ROUTINE 04360020 SPACE 1 04370020 LA UCBREG,UCBOPR GET TYPE WRITER UCB 04380020 LA CCWREG,TYPREAD GET READ CCW FOR TYPEWRITER 04390020 BAL LINK9,STARTIO ISSUE SIO 04400020 SPACE 1 04410020 TR SYIBUF(80),CONVTAB CHANGE LOWER TO UPPER CASE 04420020 SPACE 1 04430020 MSGANL MVC SYIMDL(4),SYIBUF+6 INSERT SYSIN MODEL NUMBER 04440020 MVC SYIDEV(3),SYIBUF+11 INSERT SYSIN DEVICE ADR 04450020 LA CSR2,SYIMDL CHECK SYSIN DEVICE ADR 04460020 LA CSR3,SYINTAB TABLE LIMITS START ADR AND 04470020 LA CSR5,MODTAB-5 END ADR RESPECTIVELY 04480020 BAL LINK9,DEVLUP 04490020 SPACE 1 04500020 MVC UCBSYI(1),0(CSR3) SET SYSIN DEVICE TYPE CODE 04510020 CLI UCBSYI,T2400 IS SYSIN TAPE S20201 04520020 BNE MSGANL1 NO, SKIP MODE SET 04530020 MVI SYICCW,X'93' YES, MOVE MODE SET IN 04540020 MSGANL1 LA CSR2,SYIDEV CHECK SYSIN DEVICE ADR 04550020 BAL LINK9,INTFCECK CHECK INTERFACE ADR 04560020 SPACE 1 04570020 B INPUTERR ERROR ON SYSIN DEF ENTRY 04580020 SPACE 1 04590020 STH CSR1,UCBSYI+2 INSERT SYSIN C/U IN UCB 04600020 MVC 120(8),ENIOPSW 04610020 B CLRSCAN 04620020 CON7278 DC H'7278' 2314 RESIDUAL COUNT TEST. 04630020 SPACE 2 04640020 TYPREAD CCW X'0A',SYIBUF,X'20',14 TYPEWRITER READ CCW 04650020 SPACE 2 04660020 OPRMSG DC CL30'IBC105A DEFINE INPUT DEVICE. ' 7974 04670020 DC CL11'DASDI 7.7 ' CONSOLE MESSAGE A43208 04680000 SPACE 2 04690020 EJECT 04700020 DS 0D 04710020 CONVTAB DC X'000102030405060708090A0B0C0D0E0F' CONVERT LOWER CASE 04720020 DC X'101112131415161718191A1B1C1D1E1F' TO UPPER CASE 04730020 DC X'202122232425402728292A2B2C2D2E2F' 04740020 DC X'303132333435363738393A3B3C3D3E3F' 04750020 DC X'404142434445464748494A4B4C4D4E4F' 04760020 DC X'505152535455565758595A5B5C5D5E5F' 04770020 DC X'606162636465666768696A6B6C6D6E6F' 04780020 DC X'707172737475767778797A7B7C7D7B7F' 04790020 DC X'80' 04800020 DC C'ABCDEFGHI' 04810020 DC X'8A8B8C8D8E8F' 04820020 DC X'90' 04830020 DC C'JKLMNOPQR' 04840020 DC X'9A9B9C9D9E9F' 04850020 DC X'A0A1' 04860020 DC C'STUVWXYZ' 04870020 DC X'AAABACADAEAF' 04880020 DC X'B0B1B2B3B4B5B6B7B8B9BABBBCBDBEBF' 04890020 DC X'C0' 04900020 DC C'ABCDEFGHI' 04910020 DC X'CACBCCCDCECF' 04920020 DC X'D0' 04930020 DC C'JKLMNOPQR' 04940020 DC X'DADBDCDDDEDF' 04950020 DC X'E0E1' 04960020 DC C'STUVWXYZ' 04970020 DC X'EAEBECEDEEEF' 04980020 DC C'0123456789' 04990020 DC X'FAFBFCFDFEFF' 05000020 SYIBUF DS 20F 05010020 SEREPSAV DC 28X'00' 05020020 EJECT 05030020 SPACE 3 05040020 * ********************************************** 05050020 * * DATA INPUT ROUTINE * 05060020 * ********************************************** 05070020 SPACE 3 05080020 * GR2 CONTINS THE INPUT BUFFER ADDRESS 05090020 SPACE 2 05100020 SYSIN STM 0,15,REGSV2 SAVE REGISTERS 05110020 ST GR2,SYICCW1 SET DATA ADDRESS IN CCW 05120020 MVI SYICCW1,X'02' SET READ COMMAND 05130020 LR GR4,GR2 SAVE DATA ADDRESS 05140020 LM GR2,GR3,INPUTR SET START IO PARAMETERS 05150020 BAL LINK9,STARTIO LINK TO START I/O 05160020 SPACE 1 05170020 LM 0,15,REGSV2 RESTORE REGISTER 05180020 BR LINK15 RETURN TO CALLER 05190020 SPACE 2 05200020 * CONSTANTS AND STORAGE AREAS FOR SYSTEM INPUT 05210020 SPACE 2 05220020 DS 0D 05230020 INPUTR DC A(UCBSYI) POINTER TO SYSIN UCB 05240020 DC A(SYICCW) CONTAINS CCW LIST FOR SYSIN 05250020 SPACE 1 05260020 SYICCW CCW 3,SYICCW1,X'40',1 05270020 SYICCW1 DC F'0' 05280020 DC X'20000050' 05290020 EJECT 05300020 SPACE 2 05310020 * ********************************************** 05320020 * * MESSAGE OUTPUT ROUTINE * 05330020 * ********************************************** 05340020 SPACE 2 05350020 SYSOUT STM 0,15,REGSV4 SAVE REGISTERS 05360020 CLI UCBSYO,X'00' IS OUTPUT DEVICE DEFINED 05370020 BC 7,SYSOUT1 YES - USE DEFINED OUTPUT DEVICE 05380020 SPACE 1 05390020 CLI UCBOPR,X'00' NO - IS WTO DEVICE DEFINED 05400020 BC 8,ERRWAIT W T O DEVICE IS NOT DEFINED 05410020 SPACE 1 05420020 B OPPRNT AND SET MSG LENGTH MAX 05430020 SPACE 1 05440020 SYSOUT1 ST GR2,SYOCCW STORE MSG ADR IN CCW 05450020 CLI UCBSYO,T2400 IS SYSOUT TAPE S20201 05460020 BC 8,SYOTAPE YES - ADJUST CCW LIST FOR TAPE 05470020 SPACE 1 05480020 CLI UCBSYO,T1052 IS SYSOUT TYPEWRITER S20201 05490020 BC 8,SYOTYPE YES - MODIFY CCW LIST FOR TYPE 05500020 SPACE 1 05510020 MVI SYOCCW,X'11' ASSUME DOUBLE SPACE 05520020 B SYSREF 05530020 SPACE 1 05540020 SYOTAPE MVI SYOCCW,X'01' SET TAPE WRITE OPR IN SYOCCW 05550020 LA UCBREG,UCBSYO ADR OF SYSOUT UCB 05560020 LA CCWREG,SYOTCCW POINTER TO CCW LIST 05570020 B SYSREF1 05580020 SPACE 1 05590020 SYOTYPE MVI SYOCCW,X'09' SET TYPE WRITE CMD IN SYPCCW 05600020 ST CSR1,SYOCCW+4 ENTER COUNT INTO CCW 05610020 MVI SYOCCW+4,X'20' SET FLAG IN CCW 05620020 B SYSREF 05630020 SPACE 1 05640020 SYSREF LM GR2,GR3,OUTPUTR GET UCB AND CCW LIST ADR 05650020 SPACE 1 05660020 SYSREF1 BAL LINK9,STARTIO ISSUE SIO SEQUENCE 05670020 LM 0,15,REGSV4 RESTORE REGISTERS 05680020 BR LINK15 RETURN TO CALLER 05690020 EJECT 05700020 * CONTAINS AND STORAGE AREAS FOR SYSOUT 05710020 SPACE 1 05720020 OUTPUTR DC A(UCBSYO) POINTER TO SYSOUT UCB 05730020 DC A(SYOCCW) ADR OF SYSOUT CCW LIST 05740020 SPACE 1 05750020 SYOTCCW CCW X'BB',CLEAR,X'40',1 MODE SET ODD PARITY TRANSLATOR 05760020 * ON BYTE CONVERTER OFF 05770020 SYOCCW DC A(0) SYSOUT CCW 05780020 DC X'20000080' 131 CHARACTERS 05790020 EJECT 05800020 * ********************************************** 05810020 * * WRITE TO OPERATOR ROUTINE * 05820020 * ********************************************** 05830020 SPACE 2 05840020 * GR1 CONTAINS NUMBER OF CHARACTER TO WRITE 05850020 * GR2 CONTAINS STARTING ADDRESS OF MESSAGE 05860020 SPACE 2 05870020 * SET UP CCW 05880020 SPACE 1 05890020 OPPRNT STM 0,15,REGSV6 SAVE REGISTERS 05900020 ST GR1,OPRCCW+4 STORE COUNT 05910020 ST GR2,OPRCCW STORE ADDRESS 05920020 MVI OPRCCW,X'09' WRITE COMMAND 05930020 MVI OPRCCW+4,X'20' SET SILI BIT 05940020 LM GR2,GR3,SYSOPR SPIOCS PARAMETERS 05950020 SPACE 1 05960020 * PRINT MESSAGE 05970020 SPACE 1 05980020 OPPRN1 BAL LINK9,STARTIO ISSUE SIO TO W T O 05990020 LM 0,15,REGSV6 RESTORE REGISTERS 06000020 BR LINK15 RETURN TO CALLER 06010020 SPACE 1 06020020 * TYPEWRITER ERROR - SWITCH TO PRINTER 06030020 SPACE 1 06040020 LM GR2,GR3,OUTPUTR GET SYSOUT UCB AND CCW LIST 06050020 SPACE 1 06060020 OPRBRA BC 0,OPRERR 06070020 MVI OPRBRA+1,X'F0' SET BRANCH TO EXIT 06080020 B OPPRN1 06090020 SPACE 1 06100020 OPRERR MVI OPRBRA+1,X'00' 06110020 LPSW COWAIT NO PRINTER OR 06120020 SPACE 2 06130020 * CONSTANTS AND STORAGE AREA FOR OPPRNT 06140020 SPACE 1 06150020 DS 0D 06160020 SYSOPR DC A(UCBOPR) POINTER TO TYPEWRITER UCB 06170020 DC A(OPRCCW) 06180020 SPACE 1 06190020 OPRCCW DS 1D OPPRNT CCW 06200020 EJECT 06210020 * *********************************************** 06220020 * * I/O ERROR MESSAGE FORMAT ROUTINE * 06230020 * *********************************************** 06240020 SPACE 2 06250020 IOPRNT STM 0,15,REGSV7 SAVE REGISTERS 06260020 MVI IOCONV,C' ' BLANK OUT IOCONV 06270020 MVC IOCONV+K1(L67),IOCONV CLEAR IOCONV S20201 06280020 UNPK IOCONV(5),2(3,UCBREG) UNPACK CHANNEL / UNIT 06290020 UNPK IOCONV+4(5),20(3,UCBREG) UNPACK CSW STATUS FIELD 06300020 UNPK IOCONV+8(13),24(7,UCBREG) UNPACK SENSE INFORMATION 06310020 LA CSR4,UCBSYI GET UCB ADDR M1828 06312000 CR CSR4,UCBREG IS IT UCBSYI M1828 06314000 BNE IOPRNT0 NO, 6 SENSE BYTES ONLY M1828 06316000 CLI UCBSYI,T2400 IS DEVICE TYPE = TAPE M1828 06318000 BE GETREST YES - 24 SENSE BYTES FOR TAPE M1828 06318400 IOPRNT0 LA CSR4,UCBTO GET UCB ADDR S20201 06320000 CR CSR4,UCBREG IS IT UCBTO S20201 06330020 BNE IOPRNT1 NO, 6 SENSE BYTES ONLY S20201 06340020 GETREST UNPK IOCONV+L8(L15),L24(L8,UCBREG) YES UNPACK 8 SENSE S20201 06350000 UNPK IOCONV+L22(L15),L31(L8,UCBREG) UNPACK SENSE S20201 06360020 UNPK IOCONV+L36(L15),L38(L8,UCBREG) UNPACK SENSE S20201 06370020 UNPK IOCONV+L50(L7),L45(L4,UCBREG) UNPACK CCHH S20201 06380020 IOPRNT1 CLI L0(UCBREG),DASDMAX IS IT A DASD DEVICE S20201 06390020 BH NOTDASD NO--BYPASS PRINT OF CCHH. 06400020 L CSR4,4(UCBREG) YES-POINTER TO CCW LIST. 06410020 LTR CSR4,CSR4 IS THERE A POINTER TO A CCW LIST 06420020 BC 8,NOTDASD NO--DO NOT PRINT CCHH. 06430020 L CSR4,0(CSR4) POINTER TO SEEK ADDRESS. 06440020 UNPK IOCONV+L59(L9),L2(L5,CSR4) UNPACK SEEK ADDR S20201 06450020 NOTDASD OC 16(4,UCBREG),16(UCBREG) COMMAND CODE FROM CSW OR CAW. 06460020 BC 4,CSWEXIT CSW--GO TO CSWEXIT. 06470020 SPACE 1 06480020 L CSR4,4(UCBREG) CAW--GET COMMAND CODE FROM CAW. 06490020 B CAWEXIT GO TO CAW EXIT . 06500020 SPACE 1 06510020 CSWEXIT L CSR4,16(UCBREG) GET ADDRESS IN CSW AT INTERRUPT. 06520020 S CSR4,EIGHT GET ADDRESS OF CCW THAT INTERPTD 06530020 SPACE 1 06540020 CAWEXIT UNPK IOCONV+L56(K3),L0(L2,CSR4) UNPACK COMMAND CODE S20201 06550020 TR IOCONV(L67),IOTAB-L240 TRANSLATE TO EBCDIC S20201 06560020 L WORK4,ERRORMSG PUT ADDRESS OF ERRMSG IN REG 4 06570020 AR WORK4,ERREG1 ADD VALUE OF ERREG1 TO REG. 4 06580020 MVI PRWD,C' ' CLEAR FIRST BYTE OF BUFFER. 06590020 MVC PRWD+1(131),PRWD CLEAR REMAINING BUFFER. 06600020 MVC PRWD(24),0(WORK4) INSERT INDEXED ERRMSG IN PRINT. 06610020 MVC PRWD+26(3),IOCONV+1 INSERT CHANNEL/UNIT IN MSG 06620020 MVC PRWD+L30(L2),IOCONV+L56 INSERT OPCODE IN MSG S20201 06630020 MVC PRWD+33(4),IOCONV+4 INSERT CSW STATUS IN MSG 06640020 LA GR1,PRWD+L40 FORMAT SENSE BYTES S20201 06650020 LA GR2,IOCONV+L8 FROM IOCONV S20201 06660020 LA GR3,K6 SET TO LOOP 6 TIMES S20201 06670020 PRNTLOOP MVC L0(L4,GR1),L0(GR2) MOVE UNPKED SENSE S20201 06680020 MVC L5(L4,GR1),L4(GR2) SEPARATE FROM NEXT TWO S20201 06690020 LA GR1,L11(GR1) 2 BLANKS BETWEEN WORDS S20201 06700020 LA GR2,L8(GR2) POINT TO NEXT SENSE BYTE S20201 06710020 BCT GR3,PRNTLOOP INSERT 24 SENSE BYTES S20201 06720020 MVC PRWD+A106(L8),IOCONV+L59 INSERT SEEK ADDR IF ANY S20201 06730020 LM 0,15,REGSV7 RESTORE REGISTERS 06740020 LA CSR1,A114 LOAD MESSAGE LENGTH S20201 06750020 * 06760020 * *********************************************** 06770020 * * WRITE A LINE TO MSG OUTPUT * 06780020 * *********************************************** 06790020 * 06800020 PRNT STM 0,15,REGSV7 SAVE REGISTERS 06810020 LA GR2,PRWD 132 BYTE WORD TO BE PRINTED 06820020 BAL GR15,SYSOUT PRINT ONE LINE 06830020 MVI PRWD,C' ' CLEAR PRINT AREA TO BLANKS 06840020 MVC PRWD+1(131),PRWD 06850020 LM 0,15,REGSV7 RESTORE REGS 06860020 BR LINK9 RETURN TO CALLING ROUTINE 06870020 SPACE 1 06880020 DS 0D 06890020 PRWD DC 132C' ' MESSAGE PRINT BUFFER 06900020 EJECT 06910020 * *********************************************** 06920020 * * INPUT/OUTPUT CONTROL ROUTINE * 06930020 * * * 06940020 * * ON ENTRY TO STARTIO OR STARTIOX * 06950020 * * REG UCBREG POINTS TO DEVICE UCB * 06960020 * * REG CCWREG POINTS TO EXCP CCW LIST ADR * 06970020 * * REG LINK9 IS ROUTINE LINK REGISTER * 06980020 * *********************************************** 06990020 SPACE 2 07000020 STARTIO STM 0,15,REGSV5 SAVE REGISTERS 07010020 STARTIOX ST CCWREG,72 INSERT CCW LIST ADR IN CAW 07020020 LH CSR4,2(UCBREG) ENTER C/U INTO CSR4 07030020 MVC 120(8),ENIOPSW MULTIPLEXOR RETURN POINT. 07040020 SPACE 1 07050020 STARTIO1 SSM ENABLE ENABLE I/O INTERRUPTS 07060020 MVC 120(8),ACKCSW1 SELECTOR RETURN POINT. 07070020 SPACE 1 07080020 TIOBUSY TIO 0(CSR4) CHECK DEVICE STATUS. 07090020 TM 68,X'50' BUSY - STATUS MODIFIER SET 07100020 MVI 68,X'00' CLEAR STATUS BYTES 07110020 BC 1,TIOBUSY YES, CONTROL UNIT BUSY 07120020 SSM DISABLE DISABLE I/O INTERRUPTS 07130020 SPACE 1 07140020 SIO SIO 0(CSR4) ISSUE SIO 07150020 BC 8,TIO COMMAND ACCEPTED 07160020 BC 2,SIO UNIT BUSY - RETRY 07170020 BC 1,SIOERR UNIT UNAVAILABLE - ERROR 07180020 B CKCSW CHECK ERROR CONDITION 07190020 SPACE 1 07200020 TIO TIO 0(CSR4) ISSUE TIO 07210020 BC 2,TIO BUSY - TEST AGAIN 07220020 B CKCSW CHECK ERROR CONDITION EXISTING 07230020 SPACE 1 07240020 IORTRN LM 0,15,REGSV5 RESTORE REGISTERS 07250020 BR LINK9 RETURN TO USER 07260020 SPACE 1 07270020 CKIOINT CH CSR4,58 INTERRUPT CAUSED BY PGM UCB 07280020 BE SIO YES - HAVE SERVICED - START I/O 07290020 B STARTIO1 N/ - CHK INTERRUPTS PENDING 07300020 SPACE 1 07310020 SENCCW CCW 4,IOSESV,X'20',24 SENSE COMMAND S20201 07320020 SPACE 1 07330020 IOSESV DC XL24'00' SENSE BYTE SAVE AREA S20201 07340020 IOTAB DC C'0123456789ABCDEF' 07350020 IOCONV DC XL68'00' CONVERT TO DECIMAL S20201 07360020 EJECT 07370020 * ********************************************** 07380020 * * ALL I/O INTERRUPTS ENTER HERE * 07390020 * * REG UCBREG POINTS TO INTRPTING UCB * 07400020 * ********************************************** 07410020 SPACE 1 07420020 * CHECK FOR I/O ERROR 07430020 SPACE 1 07440020 CKCSW1 TM 68,X'10' BUSY 07450020 BC 1,SIO YES--REISSUE SIO. 07460020 TM 68,X'04' DEVICE END. 07470020 BC 1,STARTIOX RETRY CCW ON DEVICE END PENDING. 07480020 TM 68,X'08' CHANNEL END. 07490020 BC 1,TIO YES--AWAIT DEVICE END. 07500020 CKCSW TM 68,X'03' IS THIS AN ERROR INTERRUPT. 07510020 BC 4,IOERR YES 07520020 TM 69,X'FF' ANY ERROR BITS ON 07530020 BC 4,IOERR YES 07540020 TM 68,X'80' IS THIS AN ATTENTION INTRPT 07550020 BC 1,ATTN YES - SETUP TO HONOR REQUEST 07560020 CLI UCBSYI,X'00' INPUT DEVICE PREVIOUSLY DEFINED. 07570020 BC 7,DEFINED YES-GO TEST FOR DEVICE END. 07580020 CLI UCBOPR,X'00' PREVIOUS CONSOLE REQUEST. 07590020 BC 8,START NO--RETURN TO START 07600020 DEFINED TM 68,X'04' IS INTERRUPT DEVICE END. 07610020 BC 1,IORTRN YES - RETURN TO PROCESS 07620020 TM 68,X'20' IS INTERRUPT CTL UNIT END 07630020 BC 1,SIO YES - REISSUE SIO 07640020 TM 68,X'08' IS INTRPT CHANNEL END 07650020 BC 1,TIO YES - LOOP ON TIO FOR DEVICE END 07660020 TM 68,X'10' IS INTERRUPT BUSY INDICATION 07670020 BC 1,SIO YES - REISSUE SIO 07680020 SPACE 1 07690020 IOERR TM ACTXIISW,X'10' IS 2321 DIRECT RETURN BIT ON. 07700020 BCR 1,LINK9 YES-RETURN TO PROCESS. 07710020 MVC 8(16,UCBREG),56 SAVE I/O PSW AND CSW IN UCB. 07720020 MVC 4(4,UCBREG),72 SAVE CAW IN UCB 07730020 MVC 24(8,UCBREG),CLEAR CLEAR SENSE FIELD OF UCB. 07740020 TM 68,X'02' IS THIS A UNIT CHECK. 07750020 BC 8,TYPECHK NO--CHECK DEVICE INTERRUPTING. 07760020 LA CSR4,SENCCW ADDRESS OF SENSE CCW. 07770020 ST CSR4,72 SET UP CAW. 07780020 LH CSR4,2(UCBREG) CHANNEL//UNIT ADDRESS. 07790020 CLI 68,X'02' UNIT CHECK ONLY. 07800020 BE SENCHK YES-GIVE SENSE COMMAND. 07810020 DEVTEST TM 68,X'04' DEVICE END PRESENT. 07820020 BC 1,SENCHK YES-GO SENSE. 07830020 DEVTIO TIO 0(CSR4) NO--TEST FOR DEVICE END. 07840020 BC 4,DEVTEST CSW STORED--TEST FOR DEVICE END. 07850020 B DEVTIO LOOP ON TIO--UNTIL DEVICE END. 07860020 SENCHK SIO 0(CSR4) ISSUE SENSE COMMAND. 07870020 BC 1,SIOERR UNIT NOT OPERATIONAL. 07880020 BC 2,SENCHK CHANNEL OR SUBCHANNEL BUSY. 07890020 IOTIO TIO 0(CSR4) TEST STATUS OF DEVICE. 07900020 BC 2,IOTIO BUSY--TRY AGAIN. 07910020 SENSAV MVC 24(6,UCBREG),IOSESV SAVE SENSE BYTES IN UCB. 07920020 CLI GTALTSW,X'FF' CHECK GETALT RTN M0990 07920421 BE CONT M0990 07920821 TM FLGDRUM,H04 CHECK FOR ALT ASSIGNED FOR ZEUS M0990 07922021 BNO CONT M0990 07924021 CLI BYPASS,X'FF' IS THE BYPASS FLAG SET M0090 07926021 BNE CONT M0990 07928021 CLI IOSESV+7,X'85' SENSE INDIC. FOR SECOND TRY M0090 07928421 BNE CONT M0990 07928821 MVI ALTCNTX+1,H00 SET THE ALTERNATE TO ZERO M0090 07929221 B INTORG M0990 07929621 CONT EQU * DELETE CHECK FOR ONLY 6 M1828 07929700 MVC L24(L24,UCBREG),IOSESV YES, SAVE 24 SENSE S20201 07960020 SENSAV1 XC IOSESV(L24),IOSESV CLEAR SENSE BYTE AREA S20201 07970020 EJECT 07980020 * CHECK DEVICE TYPE INTERRUPTING 07990020 SPACE 2 08000020 TYPECHK TM ERRETRY,X'FF' IS THE ERROR RETRY SWITCH ON. 08010020 BC 1,ERBYPASS YES-PRESERVE ORIGINAL ERROR REGS 08020020 MVC ERRSAV1(64),REGSV5 SAVE STARTIO REGS IN ERRSAV1. 08030020 SPACE 1 08040020 ERBYPASS CLI L0(UCBREG),DASDMAX DASD INTERRUPT S20201 08050020 BNH ERR100 08060020 CLI L0(UCBREG),T2400 2400 INTERRUPT S20201 08070020 BC 8,ERR300 08080020 SPACE 1 08090020 CLI L0(UCBREG),T1052 1052 INTERRUPT S20201 08100020 BC 8,ERR500 08110020 SPACE 1 08120020 CLI L0(UCBREG),T1402 1402 INTERRUPT S20201 08130020 BC 8,ERR600 08140020 SPACE 1 08150020 CLI L0(UCBREG),T1442 1442 INTERRUPT S20201 08160020 BC 8,ERR200 08170020 SPACE 1 08180020 CLI L0(UCBREG),T1403 1403 INTERRUPT S20201 08190020 BC 8,ERR400 08200020 SPACE 1 08210020 CLI L0(UCBREG),T1443 1443 INTERRUPT S20201 08220020 BC 8,ERR800 08230020 SPACE 1 08240020 B SIOERR NO DEVICE TYPE IN TABLE.. 08250020 EJECT 08260020 * VOLUME LABEL CHECK ROUTINE 08270020 * 08280020 CKVOLLBL MVI NORCDSW,X'F0' TURN ON NO RECORD FOUND SWITCH 08290020 XC SAVEVTOC(96),SAVEVTOC CLEAR VTOC/VOL LABEL BUFFER 08300020 LA UCBREG,UCBTO PREPARE TO READ DASD VOL LABEL 08310020 MVC CCHH(5),CCHHR PREPARE TO READ VOL ID 08320020 XC SEEKADR+2(4),SEEKADR+2 CLEAR THE SEEK ADDRESS 7679 08330020 RETALT LA CCWREG,SEEKVOL READ VOLUME LABEL. 08340020 BAL LINK9,STARTIO SIO FOR VOLUME LABEL 08350020 MVI NORCDSW,X'00' RESET NO RECORD SWITCH 08360020 CLC SAVEVTOC(4),VOLABID IS THIS A SYSTEM VOL LABEL 08370020 BC 8,VOLYES YES-COMPARE THE SERIAL NUMBERS. 08380020 SPACE 1 08390020 MVI NORCDSW,X'0A' NO--SET UP TO PRINT INVALID MSG. 08400020 B PRNTMESS PRINT MESSAGE ABOUT VOL I/D. 08410020 SPACE 1 08420020 VOLYES CLC VOLLABEL(6),SAVEVTOC+4 DOES VOL LABEL CHECK OUT 08430020 BNE PRNTMESS NO 08440020 MVC SEEKVOL+1(3),ADBBCCHH INSURE SEEK CCW IS RESET. 08450020 SPACE 1 08460020 CLI GTALTSW,X'FF' IS THIS A GETALT FUNCTION 08470020 BC 7,PGMRTN N/ - RETURN TO CALLER 08480020 MVC SAVALTCC(10),SAVEVTOC+11 SAVE VTOC ADDRESS 08490020 MVC CCHH(5),SAVALTCC PREPARE TO READ VTOC 08500020 BAL LINK9,STARTIO SIO FOR VTOC 08510020 MVC ALTHOLD(6),SAVEVTOC+8 08520020 PGMRTN BR LINK15 RETURN TO CALLER 08530020 SPACE 1 08540020 RCDRTN MVI NORCDSW,X'0A' SET NO RECORD SWITCH TO INVALID. 08550020 SPACE 1 08560020 PRNTMESS MVC PRWD(89),MESS7 TELL OPERATOR VOLUME LABEL 08570020 LA CSR1,89 DON'T AGREE WITH ONE MOUNTED. 08580020 BAL LINK9,PRNT 08590020 SPACE 1 08600020 TM NORCDSW,X'0A' IS VOL I/D INVALID FORMAT. 08610020 BC 14,SERPRINT NO--PRINT SERIAL ERROR MSG. 08620020 SPACE 1 08630020 MVC PRWD+9(16),INVALID TELL VOLID COULD NOT BE FOUND. 08640020 B VPRINT1 GO PRINT THE MESSAGE. 08650020 SPACE 1 08660020 SERPRINT MVC PRWD+15(6),SAVEVTOC+4 LABEL I/D. 08670020 VPRINT MVC PRWD+9(6),VOLIDIS PRINT VOLUME 08680020 VPRINT1 LA CSR1,26 LENGTH OF MESSAGE. 08690020 BAL LINK9,PRNT 08700020 LPSW COWAIT SET ERROR WAIT STATE 08710020 * 08720020 VOLIDIS DC C'VOLID=' 08730020 SPACE 1 08740020 INVALID DC C'VOLID IS INVALID' 08750020 ADBBCCHH DC AL3(BBCCHH) USED TO REST SEEKVOL. 08760020 DS 0D 08770020 SEEKVOL CCW 7,BBCCHH,X'60',6 SEEK VOLUME LABEL 08780020 SEARCHID CCW X'31',CCHH,X'60',5 SEARCH VOLUME LABEL RECORD 08790020 CCW 8,SEARCHID,X'60',5 08800020 CCW 6,SAVEVTOC,X'20',96 08810020 SPACE 1 08820020 * 08830020 SAVEVTOC DC XL96'00' BUFFER FOR VOL LABEL AND VTOC 08840020 SAVALTCC DC XL10'00' DATA DIRECTORY - VTOC ADR 08850020 DS 0F 08860020 DC XL2'00' 08870020 BBCCHH DC X'0000' BIN 08880020 CCHH DC X'0000' CYLINDER 08890020 HH DC X'0000' TRACK AND RECORD 08900020 DC XL2'00' ADR FOR CCW LIST 08910020 CCHHR DC X'0000000003' TRACK AND RECORD OF VOL ID 08920020 VOLLABEL DC XL6'00' VOL ID COMPARE 08930020 MESS7 DC C'IBC106A THE VOLID IN CONTROL STATEMENT ' 08940020 DC C'DOES NOT AGREE WITH ID IN VOL LABEL ' 08950020 DC C'WHICH FOLLOWS' 08960020 PRNTSW DC X'00' 08970020 EJECT 08980020 BIT80 EQU X'80' ERROR SWITCH 08990020 BIT40 EQU X'40' BYPASS SWITCH 09000020 BIT20 EQU X'20' EOF, PARAMETER FOLLOWS SWITCH 09010020 BIT10 EQU X'10' FIRST ENTRY, PARTIAL PARAMETER 09020020 BIT08 EQU X'08' COMMAND, COLUMN 72 NON-BLANK SW 09030020 BIT04 EQU X'04' KEYWORD, COLUMN 72 NON-BLANK SW 09040020 BIT02 EQU X'02' PARAMETER SWITCH 09050020 BIT01 EQU X'01' RIGHT PAREN, LENGTH=0 SWITCH 09060020 EQUAL EQU C'=' HEX 'EQUAL' 09070020 COMMA EQU C',' HEX 'COMMA' 09080020 MINUS EQU C'-' HEX 'MINUS' 09090020 PERIOD EQU C'.' HEX 'PERIOD' 09100020 BLANKCOL EQU C' ' BLANK CHARACTER. 09110020 RESET0 EQU X'00' RESET BITS 09120020 CARDBUFF EQU SWITCHRD+1 CARD READ-IN AREA. 09130020 LASTCOLM EQU SWITCHRD+71 LAST COLUMN 09140020 PARAMSW EQU SWITCHRD+81 PARAMETER FOLLOWS, CONTINUATION 09150020 SAVEPAPR EQU SWITCHRD+83 SAVE AREA FOR PARTIAL PARAMETERS 09160020 COL72LG EQU SWITCHRD+103 COLUMN 72 SWITCH AND LENGTH SW 09170020 DELIMIN EQU SWITCHRD+106 DELIMITER INDICATORS 09180020 DELIMIN2 EQU SWITCHRD+107 DELIMITER INDI 09190020 SAVE9 EQU SWITCHRD+108 SAVE REGISTER 9 AREA 09200020 STORGR3 EQU SWITCHRD+112 LOCATION WHERE SCAN REG3 STORED 09210020 ZERO EQU CLEAR 09220020 SPACE 1 09230020 RDCARD STM 3,15,REGSV6+12 SAVE REGS 3-15, 1-2 PARAM REGS 09240020 L GR3,STORGR3 POINTER FROM PREVIOUS SCAN SAVED 09250020 NI SWITCHRD,X'7F' RESET ERROR BIT 09260020 TM SWITCHRD,BIT10 TEST FIRST ENTRY SWITCH 09270020 BC 8,KIRSCD SWITCH OFF ON FIRST ENTRY 09280020 TM SWITCHRD,BIT40 TEST BYPASS SWITCH 09290020 BC 1,KBYPO IF ON GO TO BYPASS ROUTINE 09300020 TM PARAMSW,BIT08 TEST READ CARD SWITCH 09310020 BC 1,KGTCD IF ON, READ A CARD 09320020 TM PRNTSW,X'01' IS PRINT SWITCH ON 09330020 BC 8,KPFOL NO-DO NOT PRINT NOW 09340020 BAL LINK9,KPRNT PRINT THE CARD 09350020 OI PRNTSW,X'20' INDICATE CARD PRINTED 09360020 NI PRNTSW,X'FE' CLEAR EXTRANEOUS BITS 09370020 KPFOL TM PARAMSW,BIT20 DOES A PARAMETER FOLLOW 09380020 BC 1,SCANR YES- SCAN THE CARD 09390020 TM PARAMSW,BIT40 CONTINUATION SWITCH SET 09400020 BC 1,KCONT YES- PROCESS CONTINUED PART 09410020 LA GR3,CARDBUFF LOAD ADDRESS OF FIRST COLUMN 09420020 KNAME CLI 0(GR3),BLANKCOL IS COLUMN BLANK 09430020 LA GR5,LASTCOLM LOAD 5 WITH COLUMN 71 OF CARD 09440020 BE KOMMD YES- GO TO COMMAND WORD ROUTINE 09450020 CR GR3,GR5 TEST IF SCANNED TO COLUMN 71 09460020 BE KNOP YES- END OF CARD REACHED 09470020 LA GR3,1(GR3) GO TO NEXT COLUMN 09480020 B KNAME CHECK FOR BLANK 09490020 KOMMD LA GR3,1(GR3) SPACE TO NEXT COLUMN AFTER COMD 09500020 OI PARAMSW,BIT04 SET COMMAND SWITCH PARAM FOLLOW 09510020 OI SWITCHRD,BIT08 SET COMMAND BIT '08' 09520020 NI DELIMIN,RESET0 RESET DELIMITER INDICATORS 09530020 KABC CLI 0(GR3),BLANKCOL IS COLUMN BLANK 09540020 BNE SCAN NO- CHECK PARAMETER 09550020 CR GR3,GR5 IS THIS THE END COLUMN 09560020 BE KNOP YES- END OF CARD REACHED 09570020 LA GR3,1(GR3) ADJUST POINTER TO NEXT COLUMN 09580020 B KABC CONTINUE SCAN 09590020 KCONT LA GR3,SWITCHRD+16 SET POINTER TO COLUMN 16 09600020 NI DELIMIN,RESET0 CLEAR DELIMITER SWITCHES 09610020 SCANR NI SWITCHRD,X'F7' RESET COMMAND BIT 09620020 SCAN NI SWITCHRD,X'98' RESET ALL BUT ERROR, 1ST ENTRY 09630020 NI PARAMSW,X'14' RESET ALL BITS BUT COMD CNTL SW 09640020 MVC DELIMIN2(1),DELIMIN SAVE DELIMITER SWITCH SETTINGS 09650020 NI COL72LG,X'0C' RESET EXIT CONTROL SWITCH 09660020 NI DELIMIN,RESET0 CLEAR DELIMITER SWITCH 09670020 SR GR2,GR2 CLEAR REGISTER 09680020 LR GR1,GR3 SAVE POINTER TO PRESENT COLUMN 09690020 LA GR5,LASTCOLM LOAD ADDRESS OF END COLUMN 09700020 KOMPAR CLI 0(GR3),EQUAL IS CHARACTER A DELIMITER 09710020 BNH DELIMIT YES-'EQUAL' CHARACTER OR LOWER 09720020 KOMPARA LA GR2,1(GR2) ADD 1 TO THE LENGTH. 09730020 CR GR3,GR5 IS THIS THE END COLUMN 09740020 BE KPART YES-GO TO PARTIAL PARAMETER SAVE 09750020 LA GR3,1(GR3) UP POINTER TO NEXT COLUMN 09760020 B KOMPAR CONTINUE SCANNING FOR DELIMITER 09770020 KNOP OI SWITCHRD,BIT80 FLAG AS NO COMD OR PARAM ON CARD 09780020 LM 1,2,ZERO CLEAR LENGTH AND SCAN REGISTERS 09790020 KNOPAR OI SWITCHRD,BIT40 NO KEYWORD OR PARAMETERS FOLLOW 09800020 KPASS LA GR3,1(GR3) UP POINTER TO NEXT COLUMN 09810020 NI PARAMSW,X'EB' CLEAR ALL BUT BYPASS-PART PARAM. 09820020 ST GR3,STORGR3 SAVE REG3 FOR NEXT ENTRY 09830020 LM 3,15,REGSV6+12 RESTORE REGISTERS 3-15, 1,2 SET 09840020 BR LINK14 RETURN TO USER. 09850020 DELIMIT CLI 0(GR3),PERIOD IS THIS A PERIOD. 09860020 BE KOMPARA YES-THIS IS OKAY. 09870020 CLI 0(GR3),MINUS IS THIS A HYPHEN. 09880020 BE KOMPARA YES-THIS IS OKAY. 09890020 CR GR3,GR5 IS THIS THE END COLUMN. 09900020 BE SETCC2 YES- SET INDICATOR 09910020 OI COL72LG,BIT40 SET DELIMITER BEFORE LAST SWITCH 09920020 TM PARAMSW,BIT10 IS PARTIAL PARAMETER SWITCH ON 09930020 BC 1,KPPAR YES-COMPLETE PARAMETER 09940020 B TESTPAR CHECK PARAMETER 09950020 LENGTH0 OI COL72LG,BIT01 SET LENGTH EQUAL TO ZERO 09960020 B DELIM CHECK DELIMITERS 09970020 SETCC2 OI COL72LG,BIT20 SET DELIMITER IN LAST SWITCH 09980020 TM PARAMSW,BIT10 IS PARTIAL PARAMETER SWITCH ON 09990020 BC 1,KTERBY YES- LENGTH IS TOO LONG 10000020 TESTPAR LTR GR4,GR2 LOAD PARM LENGTH S20201 10010020 BC 8,LENGTH0 LENGTH EQUALS ZERO, SET SWITCH 10020020 OI COL72LG,BIT02 SET LENGTH GREATER THAN ZERO 10030020 DELIM CLI 0(GR3),EQUAL TEST IF DELIMITER IS AN EQUAL 10040020 BE KEY YES- GO TO KEY WORD ROUTINE 10050020 CLI 0(GR3),COMMA TEST FOR COMMA 10060020 BE PARAMC YES- GO TO PARAMETER ROUTINE 10070020 CLI 0(GR3),BLANKCOL TEST FOR BLANK 10080020 BE PARBLANK YES- GO TO HANDLE BLANK PARAM 10090020 OI SWITCHRD,BIT80 SET ERROR BIT 10100020 TM COL72LG,BIT20 IS DELIMITER IN END COLUMN 10110020 BC 1,KSETP YES- SET PARAMETER FOLLOWS SW. 10120020 KINVAL OI SWITCHRD,BIT80 SET INVALID DELIMITER ERROR SW 10130020 LA GR2,1(GR2) ADJUST LENGTH REGISTER 10140020 LA GR3,1(GR3) ADJUST SCAN POINTER 10150020 CLI 0(GR3),EQUAL TEST FOR DELIMITER 10160020 BNH KINV YES- TWO DELIMITERS IN A ROW 10170020 CR GR3,GR5 END COLUMN 10180020 BL KINVAL NO- SCAN SOME MORE 10190020 TM COL72LG,BIT08 IS COLUMN 72 BLANK 10200020 BC 1,KTERBY YES 10210020 LA GR2,1(GR2) UP LENGTH REGISTER 10220020 B KPTERR ESTABLISH PARAMETER 10230020 KINV TM PARAMSW,BIT04 IS COMMAND CONTROL SWITCH ON 10240020 BC 1,KPCMD YES- ADJUST POINTER TO NEXT ONE 10250020 PRFOL OI PARAMSW,BIT20 SET PARAMETER FOLLOWS SWITCH 10260020 B KPASS GO TO RETURN 10270020 KBYPO CLI SWITCHRD+72,BLANKCOL IS COLUMN 72 BLANK 10280020 BNE KGTCD NO- GET ANOTHER CARD 10290020 NI SWITCHRD,BIT10 RESET PARTIAL PARAMETER SWITCH 10300020 NI PARAMSW,RESET0 RESET ENTRY CONTROL SWITCH 10310020 NI PRNTSW,X'DE' RESET EXTRANEOUS BITS 10320020 B KGTCD READ A CARD 10330020 KIRSCD OI SWITCHRD,BIT10 SET FIRST ENTRY SWITCH 10340020 SR GR3,GR3 CLEAR SCAN REGISTER 10350020 STC GR3,PARAMSW CLEAR PARAMETER SWITCH 10360020 STC GR3,COL72LG CLEAR COLUMN 72 SWITCH 10370020 KGTCD LA GR2,CARDBUFF ADDRESS OF INPUT BUFFER 10380020 BAL LINK15,SYSIN READ A CARD FROM INPUT DEVICE 10390020 TM PRNTSW,X'20' TEST DELAY PRINT SETTING 10400020 BC 8,KGTCDR DD NOT PRINT CARD NOW 10410020 BAL GR9,KPRNT PRINT CARD 10420020 KGTCDR NI COL72LG,RESET0 CLEAR COLUMN 72 SWITCH 10430020 CLI SWITCHRD+72,BLANKCOL IS COLUMN 72 BLANK 10440020 BNE CLMNOTBL COLUMN 72 IS NOT BLANK 10450020 OI COL72LG,BIT08 SET 72 BLANK SWITCH 10460020 RETURN TM SWITCHRD,BIT40 IS BYPASS SWITCH ON 10470020 BC 1,KBYPO YES- BYPASS CARD 10480020 B KPFOL START SCAN 10490020 CLMNOTBL OI COL72LG,BIT04 SET 72 NOT BLANK SWITCH IN CASE 10500020 B RETURN CHECK SOME MORE 10510020 PARBLANK TM PARAMSW,BIT04 IS COMMAND SWITCH ON 10520020 BC 1,KPCMD YES-GO TO ADJUST POINTER 10530020 OI SWITCHRD,BIT02 SET PARAMETER PRESENT BIT 10540020 OI DELIMIN,BIT08 SET BLANK DELIMITER SWITCH 10550020 DECID TM COL72LG,BIT20 IS DELIMITER IN END COLUMN 10560020 BC 1,KWENT YES- SET TO READ A CARD 10570020 TM COL72LG,BIT01 IS LENGTH EQUAL TO ZERO 10580020 BC 1,KFORZRO YES-SET UP FOR ZERO LENGTH 10590020 OI PARAMSW,BIT20 SET PARAMETER FOLLOWS SWITCH 10600020 TM DELIMIN,BIT08 IS DELIMITER A BLANK 10610020 BC 8,KPASS NO- RETURN WITH POINTERS SET 10620020 KETBYP OI SWITCHRD,BIT40 SET BYPASS SWITCH 10630020 B KPASS GET SET TO RETURN 10640020 KFORZRO LM GR1,GR2,ZERO CLEAR REGISTERS 1 AND 2 10650020 TM DELIMIN,BIT08 IS DELIMITER A BLANK 10660020 BC 1,KETRDCD GO TO SET READ CARD AND CONTINUE 10670020 OI PARAMSW,BIT20 SET PARAMETER FOLLOWS SWITCH 10680020 TM DELIMIN,BIT80 IS DELIMITER AN EQUAL SIGN 10690020 BC 1,KTER YES- SET UP ERROR CONDITION 10700020 B KPASS RETURN 10710020 KETRDCD OI PARAMSW,X'48' SET TO READ CARD AND CONTINUE 10720020 TM DELIMIN2,BIT40 IS LAST DELIMITER A COMMA 10730020 BC 1,KGTCD YES- READ A CARD 10740020 TM COL72LG,BIT08 IS COLUMN 72 BLANK 10750020 BC 8,KETBYP NO- SET BYPASS SWITCH AND RETURN 10760020 LA GR4,SWITCHRD+16 CARD COLUMN 16 10770020 CR GR3,GR4 IS SCAN ON COLUMN 16 10780020 BE KETBYP YES- SET BYPASS SWITCH 10790020 TM DELIMIN2,EQUAL WAS LAST DELIMITER AN EQUAL 10800020 BC 1,KETBYP YES- SET BYPASS SWITCH 10810020 KTERBY OI SWITCHRD,BIT40 SET BYPASS SWITCH 10820020 KTER OI SWITCHRD,BIT80 SET ERROR SWITCH 10830020 B KPASS RETURN 10840020 KWENT OI PARAMSW,X'48' SET TO READ CARD AND CONTINUE 10850020 TM COL72LG,BIT08 IS COLUMN 72 BLANK 10860020 BC 1,KETCTBL YES- SET BYPASS SWITCH AND CHECK 10870020 TM COL72LG,BIT01 IS LENGTH EQUAL TO ZERO 10880020 BC 1,KZERO NO- RETURN 10890020 TM DELIMIN,BIT08 IS DELIMITER A BLANK 10900020 BC 1,KETBYP YES- SET BYPASS SWITCH, RETURN 10910020 B KPASS RETURN 10920020 KZERO SR GR1,GR1 CLEAR REGISTER 10930020 TM DELIMIN,BIT80 IS DELIMITER AN EQUAL 10940020 BC 1,KTER YES- SET ERROR SWITCH 10950020 TM DELIMIN,BIT40 IS DELIMITER A COMMA 10960020 BC 8,KGTCD NO- READ A CARD 10970020 CLC DELIMIN(1),DELIMIN2 IS DELIMITER SAME AS LAST 10980020 BE KPASS YES- RETURN 10990020 KETCTBL OI SWITCHRD,BIT40 SET BYPASS SWITCH 11000020 TM DELIMIN,BIT40 IS DELIMITER A COMMA 11010020 BC 1,KTER YES- SET ERROR SWITCH 11020020 B KPASS RETURN 11030020 KEY OI SWITCHRD,BIT04 SET KEY WORD SWITCH 11040020 OI DELIMIN,BIT80 SET DELIMITER SWITCH 11050020 B DECID GO TO CHECK DELIMITER 11060020 PARAMC OI SWITCHRD,BIT02 SET PARAMETER BIT 11070020 OI DELIMIN,BIT40 SET DELIMITER COMMA SWITCH 11080020 B DECID GO TO CHECK DELIMITER 11090020 KPART TM PARAMSW,BIT10 IS PARTIAL PARAMETER SWITCH ON 11100020 BC 1,KTERBY YES-SET BYPASS AND ERROR SWITCH 11110020 KPTERR OI PARAMSW,BIT10 SET PARTIAL PARAMETER SWITCH 11120020 TM COL72LG,BIT08 IS COLUMN 72 BLANK 11130020 BC 1,KLAST YES- GO TO SET PARAMETER BIT 11140020 MVI SAVEPAPR,BIT40 FLAG PARTIAL PARAMETER STORED 11150020 MVC SAVEPAPR+1(19),SAVEPAPR STORE PARTIAL PARAMETER 11160020 STC GR2,SWITCHRD+82 SAVE LENGTH OF PARTIAL PARAMETER 11170020 BCTR GR2,0 DECREMENT COUNT FOR MOVE 11180020 EX GR2,MOVEP MOVE PARTIAL PARAMETER TO BUFFER 11190020 OI PARAMSW,BIT40 SET CONTINUE BIT 11200020 TM COL72LG,BIT04 IS COLUMN 72 BLANK 11210020 BC 1,KGTCD NO- GET A CARD 11220020 OI SWITCHRD,BIT80 YES- FLAG AS ERROR 11230020 B KETBYP SET BYPASS SWITCH 11240020 KLAST OI SWITCHRD,BIT02 SET PARAMETER BIT 11250020 B KETBYP SET BYPASS BIT 11260020 KPPAR SR GR4,GR4 CLEAR REGISTER 11270020 IC GR4,SWITCHRD+82 LENGTH OF FIRST PART. 11280020 LTR GR2,GR2 IS LENGTH OF 2ND PART ZERO. 11290020 BC 8,KOMPL YES-THE PARAMETER IS COMPLETE. 11300020 LA GR6,SAVEPAPR NO--ADDRESS OF FIRST PART. 11310020 AR GR6,GR4 ADDRESS TO MOVE IN 2ND PART. 11320020 BCTR GR2,0 DECREMENT COUNT FOR MOVE 11330020 EX GR2,MOVEPP RECREATE COMPLETE PARAMETER. 11340020 LA GR2,1(GR2) UP COUNT TO WHERE IT WAS 11350020 KOMPL AR GR2,GR4 TOTAL LENGTH OF PARAMETER. 11360020 LA GR1,SAVEPAPR LOAD PARAMETER BUFFER ADDRESS 11370020 NI COL72LG,X'0C' CLEAR LENGTH BITS, LEAVE'72' BIT 11380020 OI COL72LG,X'42' SET LENGTH GREATER THAN ZERO 11390020 MVC DELIMIN2(1),DELIMIN SAVE DELIMITER SWITCH SETTINGS 11400020 NI DELIMIN,RESET0 CLEAR DELIMITER BITS 11410020 NI PARAMSW,X'EF' RESET PARTIAL PARAMETER SWITCH 11420020 B DELIM CHECK DELIMITERS 11430020 KPCMD LA GR3,1(GR3) ADJUST POINTER TO NEXT COLUMN 11440020 CLI 0(GR3),BLANKCOL IS COLUMN BLANK 11450020 BNE KPCMA NO- CHECK FOR COMMA 11460020 CR GR5,GR3 IS THIS THE LAST COLUMN 11470020 BE KNOPAR YES- NO PARAMETER FOLLOWS 11480020 B KPCMD CONTINUE SCAN 11490020 KPCMA CLI 0(GR3),COMMA IS COMMA THE FIRST CHARACTER 11500020 BE KNOPAR YES- NO PARAMETER FOLLOWS 11510020 BCTR GR3,0 BACK UP REGISTER 3 TO PARAMETER 11520020 B PRFOL GO TO SET UP FOR PARAMETER 11530020 KSETP OI PARAMSW,BIT10 SET PARAMETER FOLLOWS SWITCH 11540020 LA GR2,1(GR2) UP LENGTH 11550020 B KPTERR GO TO SET PARTIAL PARAMETER BIT 11560020 KPRNT MVC PRWD(80),CARDBUFF MOVE CONTROL CARD TO BUFFER 11570020 WASH LA GR1,71 SIZE OF CARD IN BYTES 49363 11580000 ST GR9,SAVE9 SAVE REGISTER 9 TEMPORARILY 11590020 LA GR9,PRWD LOAD BUFFER ADDRESS 49363 11592000 AR GR9,GR1 LOCATE BUFFER AT END 49363 11594000 RANDLE CLI 0(GR9),C' ' BLANK SPACES 49363 11596000 BNE MTS NO - EXIT 49363 11598000 BCTR GR9,0 DECREMENT BUFFER ADDR 49363 11598400 BCT GR1,RANDLE DECREMENT COUNTER 49363 11598800 MTS LA GR1,1(GR1) ADD 1 TO COUNTER 49363 11599200 BAL GR9,PRNT PRINT THE CARD 11600020 L GR9,SAVE9 RELOAD REGISTER 9 11610020 BR GR9 RETURN TO USER 11620020 MOVEP MVC SAVEPAPR(1),0(GR1) STORE PARTIAL PARAMETER 11630020 MOVEPP MVC 0(1,GR4),0(GR1) RECREATES PARAMETER 11640020 EJECT 11650020 * ********************************************************* 11660020 * * COMMON I/O STATUS & SENSE BIT ERROR INTERPRET ROUTINE * 11670020 * ********************************************************* 11680020 SPACE 3 11690020 NEXTBIT LA ERRLNK,2(ERRLNK) ADDR. OF NEXT STATUS/SENSE BIT. 11700020 SPACE 1 11710020 ERRTEST SR ERREG1,ERREG1 ZERO REGISTER---NORMAL ENTRY--- 11720020 IC ERREG1,0(ERRLNK) GET SENSE OR STATUS CODE BIT 11730020 TM 0(ERRLNK),STATMASK IS STATUS BYTES TO BE TESTED ? 11740020 BC 1,STATTEST YES--GO TO STATUS TEST ROUTINE. 11750020 LH ERREG4,24(UCBREG) NO--GET 2 SENSE BYTES FROM UCB. 11760020 SPACE 1 11770020 SHIFTBIT LNR ERREG1,ERREG1 COMPLMT CODE BIT/GET SHIFT FACTR 11780020 LA ERREG3,1 INITIATE REG TO 1 11790020 SLA ERREG3,15(ERREG1) SHIFT TO FIND POSITION OF BIT 11800020 BC 1,ERREND END OF TEST 11810020 NR ERREG3,ERREG4 TEST IF CODE BIT IS ON 11820020 BC 8,NEXTBIT NO, GET THE NEXT BIT 11830020 SPACE 1 11840020 ERREND SR ERREG1,ERREG1 ZERO REGISTER 11850020 IC ERREG1,1(ERRLNK) GET DISPLACEMENT 11860020 BC 15,0(ERREG1,ERRLNK) BRANCH TO PROPER ROUTINE 11870020 SPACE 1 11880020 STATTEST LH ERREG4,20(UCBREG) GET 2 STATUS BYTES FROM UCB. 11890020 N ERREG1,STATZERO ZERO STATUS CODE BIT 11900020 BC 15,SHIFTBIT BR-CHECK STATUS BITS 11910020 SPACE 3 11920020 DS 0F 11930020 STATZERO DC X'0000000F' ZEROES THE HIGH ORDER OF STATUS 11940020 STATMASK EQU X'10' '10' INDICATES A STATUS BYTE 11950020 BUFCCW CCW X'24',SAVECC1,X'30',128 DUMP BUFLOG CCW S20201 11960020 SAVECCW DC H'0' ADDR OF CCW IN ERROR S20201 11970020 SAVECC1 DC F'0' READ BUFLOG AREA S20201 11980020 EJECT 11990020 * ************************************************************ 12000020 * * FOLLOWING ROUTINES USED BY 2301,2302,2303,2305,2311 * 12010020 * * 2314,2321 AND 3330 DASD DEVICES. * 12020020 * ************************************************************ 12030020 SPACE 2 12040020 * DASD TEST CHANNEL STATUS BYTES ROUTINE. 12050020 SPACE 2 12060020 ERR100 BAL ERRLNK,ERRTEST LINK TO STATUS/SENSE BYTES TEST. 12070020 DC X'1D' CHANNEL CONTROL CHECK 12080020 DC AL1(ERR101-ERR100-4) 12090020 DC X'1E' INTERFACE CONTROL CHECK 12100020 DC AL1(ERR102-ERR100-6) 12110020 DC X'1C' CHANNEL DATA CHECK 12120020 DC AL1(ERR103-ERR100-8) 12130020 DC X'10' SHOULD NOT OCCUR 12140020 DC AL1(ERR104-ERR100-10) 12150020 DC X'16' UNIT CHECK 12160020 DC AL1(ERR130A-ERR100-12) 12170020 DC X'1F' CHAINING CHECK 12180020 DC AL1(ERR105-ERR100-14) 12190020 DC X'1A' PROGRAM CHECK 12200020 DC AL1(ERR106-ERR100-16) 12210020 DC X'1B' PROTECTION CHECK 12220020 DC AL1(ERR107-ERR100-18) 12230020 DC X'17' UNIT EXCEPTION 12240020 DC AL1(ERR108-ERR100-20) 12250020 DC X'19' INCORRECT LENGTH 12260020 DC AL1(ERR109-ERR100-22) 12270020 DC X'2F' END OF TEST 12280020 DC AL1(ERR110-ERR100-24) 12290020 SPACE 2 12300020 * 2302,2303,2311,2314 TEST CHANNEL SENSE BYTES 12310020 SPACE 2 12320020 ERR130A CLI L0(UCBREG),T2301 2301 DEVICE S20201 12330020 BE ERR730 YES, TEST SENSE FOR 2301 S20201 12340020 CLI L0(UCBREG),T23A5 IS DEVICE A 2305-1 S20201 12350020 BE ERRB00 USE 2305-1 SENSE RTN S20201 12360020 CLI L0(UCBREG),T23C5 IS DEVICE A 2305-2 S20201 12370020 BE ERRB00 USE 2305-2 SENSE RTN S20201 12380020 CLI L0(UCBREG),T3330 IS DEVICE A 3330 S20201 12390020 BE ERRB00 USE 3330 SENSE BYTE RTN S20201 12400020 CLI L0(UCBREG),T2321 2321 SENSE S20201 12410020 BE ERR900 12420020 ERR130 BAL ERRLNK,ERRTEST LINK TO STATUS/SENSE BYTE TEST 12430020 DC X'03' EQUIPMENT CHECK 12440020 DC AL1(ERR131-ERR130-4) 12450020 DC X'0C' NO RECORD FOUND 12460020 DC AL1(ERR132-ERR130-6) 12470020 DC X'07' SEEK CHECK 12480020 DC AL1(ERR139-ERR130-8) 12490020 DC X'01' INTERVENTION REQUIRED 12500020 DC AL1(ERR133-ERR130-10) 12510020 DC X'02' BUS OUT CHECK 12520020 DC AL1(ERR134-ERR130-12) 12530020 DC X'04' DATA CHECK 12540020 DC AL1(ERR135-ERR130-14) 12550020 DC X'05' OVERRUN 12560020 DC AL1(ERR137-ERR130-16) 12570020 DC X'00' COMMAND REJECT M0158 12580021 DC AL1(ERR138-ERR130-18) M0158 12590021 DC X'0E' MISSING ADDRESS MARKER M0158 12600021 DC AL1(ERR145-ERR130-20) M0158 12610021 DC X'06' TRACK CONDITION CHECK 12620020 DC AL1(ERR140-ERR130-22) 12630020 DC X'09' TRACK OVERRUN 12640020 DC AL1(ERR141-ERR130-24) 12650020 DC X'0A' END OF CYLINDER 12660020 DC AL1(ERR142-ERR130-26) 12670020 DC X'0D' FILE PROTECT 12680020 DC AL1(ERR143-ERR130-28) 12690020 DC X'0F' DASD OVERFLOW INCOMPLETE 12700020 DC AL1(ERR144-ERR130-30) 12710020 DC X'2F' END OF TEST 12720020 DC AL1(ERR146-ERR130-32) 12730020 SPACE 2 12740020 * EXITS TO DASD ERROR RECOVERY ROUTINES 12750020 SPACE 2 12760020 ERR101 BC 15,CHANERR GO TO CHANNEL CONTROL CHECK RTN. 12770020 SPACE 1 12780020 ERR102 BC 15,INFCERR GO TO INTERFACE CONTROL CHECK 12790020 SPACE 1 12800020 ERR103 BAL LINK15,TWOTRY RETRY CCW LIST 12810020 B CHDATA GO TO CHANNEL DATA CHECK ROUTNE 12820020 SPACE 1 12830020 ERR104 BC 15,NEVER GO TO SHOULD NOT OCCUR ROUTINE. 12840020 SPACE 1 12850020 ERR105 BAL LINK15,TENTRY RETRY ERROR CCW LIST 10 TIMES 12860020 BC 15,CHAINCHK SOLID ERROR-GO TO CHAINCHK RTN. 12870020 SPACE 1 12880020 ERR106 BC 15,PROCHK GO TO PROGRAM CHECK ROUTINE 12890020 SPACE 1 12900020 ERR107 BC 15,PTNCHK GO TO PROTECTION CHECK ROUTINE 12910020 SPACE 1 12920020 ERR108 BC 15,UNITCEPT GO TO UNIT EXCEPTION ROUTINE 12930020 SPACE 1 12940020 ERR109 BC 15,WLRERR GO TO INCORRECT LENGTH ROUTINE 12950020 SPACE 1 12960020 ERR110 BC 15,ENDTEST GO TO END OF TEST ROUTINE 12970020 SPACE 1 12980020 ERR131 BAL LINK15,TENTRY RETRY ERROR CCW UP TO 10 TIMES. 12990020 BC 15,EQUIPCHK SOLID ERROR-GO TO EQUIPCHK ROUTINE 13000020 SPACE 1 13010020 ERR132 TM 25(UCBREG),X'02' IS MISS ADD MARK ALSO 13020020 BO ERR132A YES - DO TWO SEEK 13030020 BAL LINK15,CYLNCHK NO - CHECK FOR CORRECT CYLIND 13040020 BAL LINK14,TENSEEK SEEK 10 TIMES IF ERROR PERSISTS 13050020 B NORECFND SOLID - GO TO NORECFND RTN. 13060020 SPACE 1 13070020 ERR132A CLI L0(UCBREG),T2303 IS THIS A 2303 DRUM S20201 13080020 BNE ERR132B NO--PROCESS AS NORMAL ERROR. 13090020 TM SPIOSW,X'F0' IS THIS A SURFACE ANALYSIS TEST. 13100020 BO SURCHECK YES--GO PROCESS ERROR. 13110020 ERR132B BAL LINK14,T3SEEK RECALIBRAYE/RETRY 3 TIMES. 13120020 B NORECFND SOLID 13130020 SPACE 1 13140020 ERR133 BAL LINK15,INTVREQ LINK TO INTERVENTION REQ. ROUTIN 13150020 MVC READYDEV(27),DISKMSG INSERT DISKMSG//CLEAR CUU FIELD. 13160020 MVC READYDEV+20(3),IOCONV+1 SET DEVICE ADDR. IN OPR MESSAGE. 13170020 B DEVWAIT GO TO DEVICE WAIT ROUTINE. 13180020 SPACE 1 13190020 ERR134 BAL LINK15,TENTRY RETRY ERROR CCW TENTIMES 13200020 BC 15,BUSOUT 13210020 SPACE 1 13220020 ERR135 TM SPIOSW,X'F0' IS SURFACE ANALYSIS SWITCH ON? 13230020 BC 1,SURCHECK YES-GO TO ENTRY COUNTER RTN. 13240020 BAL LINK15,SIXTTRY GO TO 16X16 RECOVERY ROUTINE. 13250020 BC 15,DATACHK SOLID ERROR-GO TO DATACHK RTN. 13260020 SPACE 1 13270020 ERR137 BAL LINK15,TENTRY RETRY ERROR CCW TEN TIMES 13280020 BC 15,OVRRUN SOLID ERROR-GO TO OVERRUN RTN. 13290020 SPACE 1 13300020 ERR138 TM 25(UCBREG),X'02' IS WRITE INHIBIT ON M0158 13305021 BO INHIBIT YES,PRINT ERROR MSG M0158 13310021 B COMREJ NO,USE COMMAND REJ RTN M0158 13315021 SPACE 1 13320020 ERR139 BAL LINK14,TENSEEK SEEK 10 TIMES IF ERROR PERSISTS. 13330020 BC 15,SEEKCHK SOLID ERROR-GO TO SEEKCHK RTN. 13340020 SPACE 1 13350020 ERR140 B TRACKCHK GO TO FILE PROTECT ROUTINE 13360020 SPACE 1 13370020 ERR141 CLI SPIOSW,X'F0' OCCUR DURING SURFACE ANALYSIS. 13380020 BNE TROVRRUN NO--GO GIVE ERROR MESSAGE. 13390020 CLI UCBTO,T2314 IS THIS A 2314 S20201 13400020 BNE TROVRRUN NO--GO GIVE ERROR MESSAGE. 13410020 LA GR3,READHOME READ HOME ADDRESS CCW. 13420020 BAL LINK9,STARTIO READ IN THE HOME ADDRESS. 13430020 TM HOMEBUF,X'02' WAS THIS A DEFECTIVE TRACK. 13440020 BZ TROVRRUN NO--UNEXPECTED TRACK OVERRUN. 13450020 B ALTE2314 YES-TRACK HAD BAD HA-R0 AREA. 13460020 SPACE 1 13470020 ERR142 BC 15,ENDOFCYL GO TO END OF CYLINDER ROUTINE 13480020 SPACE 1 13490020 ERR143 BAL LINK15,CYLNCHK VERIFY SEEKED TO CORRECT CYLINDE 13500020 BAL LINK14,TENSEEK SEEK 10 TIMES IF ERROR PERSISTS. 13510020 BC 15,FILEPROT SOLID ERROR-GO TO FILEPROT RTN. 13520020 SPACE 1 13530020 ERR144 BC 15,OVRFLOW GO TO OVERFLOW INCOMPLETE RTN. 13540020 SPACE 1 13550020 ERR145 BAL LINK15,TENTRY RETRY ERROR CCW TEN TIMES 13560020 B MISSMARK GO TO MISSING ADDRESS MARKER RT 13570020 SPACE 1 13580020 ERR146 BC 15,ENDTEST GO TO END OF TEST ROUTINE. 13590020 EJECT 13600020 * ******************************************** 13610020 * * FOLLOWING ROUTINES USED BY 1442 READER * 13620020 * ******************************************** 13630020 SPACE 1 13640020 * 1442 TEST CHANNEL STATUS BYTES ROUTINE. 13650020 SPACE 2 13660020 ERR200 BAL ERRLNK,ERRTEST LINK TO STATUS/SENSE BYTES TEST. 13670020 DC X'1D' CHANNEL CONTORL CHECK 13680020 DC AL1(ERR201-ERR200-4) 13690020 DC X'1E' INTERFACE CONTROL CHECK 13700020 DC AL1(ERR202-ERR200-6) 13710020 DC X'1C' CHANNEL DATA CHECK 13720020 DC AL1(ERR203-ERR200-8) 13730020 DC X'10' SHOULD NOT OCCUR 13740020 DC AL1(ERR204-ERR200-10) 13750020 DC X'11' SHOULD NOT OCCUR 13760020 DC AL1(ERR204-ERR200-12) 13770020 DC X'12' SHOULD NOT OCCUR 13780020 DC AL1(ERR204-ERR200-14) 13790020 DC X'16' UNIT CHECK 13800020 DC AL1(ERR230-ERR200-16) 13810020 DC X'1F' CHAINING CHECK 13820020 DC AL1(ERR205-ERR200-18) 13830020 DC X'1A' PROGRAM CHECK 13840020 DC AL1(ERR206-ERR200-20) 13850020 DC X'1B' PROTECTION CHECK 13860020 DC AL1(ERR207-ERR200-22) 13870020 DC X'17' UNIT EXCEPTION 13880020 DC AL1(ERR208-ERR200-24) 13890020 DC X'19' INCORRECT LENGTH 13900020 DC AL1(ERR209-ERR200-26) 13910020 DC X'2F' END OF TEST 13920020 DC AL1(ERR210-ERR200-28) 13930020 SPACE 1 13940020 * 1442 TEST CHANNEL SENSE BYTES ROUTINE. 13950020 SPACE 1 13960020 ERR230 BAL ERRLNK,ERRTEST LINK TO STATUS/SENSE BYTES TEST. 13970020 DC X'06' SHOULD NOT OCCUR 13980020 DC AL1(ERR231-ERR230-4) 13990020 DC X'07' SHOULD NOT OCCUR 14000020 DC AL1(ERR231-ERR230-6) 14010020 DC X'03' EQUIPMENT CHECK 14020020 DC AL1(ERR232-ERR230-8) 14030020 DC X'01' INTERVENTION REQUIRED 14040020 DC AL1(ERR233-ERR230-10) 14050020 DC X'02' BUS OUT CHECK 14060020 DC AL1(ERR234-ERR230-12) 14070020 DC X'04' DATA CHECK 14080020 DC AL1(ERR235-ERR230-14) 14090020 DC X'05' OVERRUN 14100020 DC AL1(ERR236-ERR230-16) 14110020 DC X'00' COMMAND REJECT 14120020 DC AL1(ERR237-ERR230-18) 14130020 DC X'2F' END OF TEST 14140020 DC AL1(ERR238-ERR230-20) 14150020 SPACE 1 14160020 * EXITS TO 1442 ERROR RECOVERY ROUTINES 14170020 SPACE 1 14180020 ERR201 BC 15,CHANERR GO TO CHANNEL CONTROL CHECK RTN. 14190020 SPACE 1 14200020 ERR202 BC 15,INFCERR GO TO INTERFACE CONTROL CHECK 14210020 SPACE 1 14220020 ERR203 BC 15,CHDATA GO TO CHANNEL DATA ERROR ROUTINE 14230020 SPACE 1 14240020 ERR204 BC 15,NEVER GO TO SHOULD NOT OCCUR ROUTINE 14250020 SPACE 1 14260020 ERR205 BC 15,CHAINCHK GO TO CHAINING CHECK ROUTINE 14270020 SPACE 1 14280020 ERR206 BC 15,PROCHK GO TO PROGRAM CHECK ROUTINE 14290020 SPACE 1 14300020 ERR207 BC 15,PTNCHK GO TO PROTECTION CHECK ROUTINE 14310020 SPACE 1 14320020 ERR208 BC 15,UNITCEPT GO TO UNIT EXCEPTION ROUTINE 14330020 SPACE 1 14340020 ERR209 BC 15,WLRERR GO TO INCORRECT LENGTH ROUTINE 14350020 SPACE 1 14360020 ERR210 BC 15,ENDTEST GO TO END OF TEST ROUTINE 14370020 SPACE 1 14380020 ERR231 BC 15,NEVER GO TO SHOULD NOT OCCUR ROUTINE 14390020 SPACE 1 14400020 ERR232 LA GR2,READCHK ADDRESS OF READER CHECK MESSAGE. 14410020 LA GR1,60 LENGTH OF MESSAGE IN BYTES. 14420020 BC 15,TYPEWAIT GO TO TYPE MESSAGE//WAIT ROUTINE 14430020 SPACE 1 14440020 ERR233 BAL LINK15,INTVREQ LINK//INTERVENTION REQUIRED RTN. 14450020 MVC READYDEV(27),READYRDR INSERT READYRDR/CLEAR CUU FIELD. 14460020 MVC READYDEV+22(3),IOCONV+1 SET DEV9CE ADDR. IN OPR MESSAGE. 14470020 B DEVWAIT GO TO DEVICE WAIT ROUTINE. 14480020 SPACE 1 14490020 ERR234 BAL LINK15,TWOTRY RETRY ERROR CCW LIST ONCE MORE. 14500020 BC 15,BUSOUT SOLID ERROR-GO TO BUSOUT RTN. 14510020 SPACE 1 14520020 ERR235 LA GR2,INVALCRD ADDRESS OF INVALID CARD CODE MSG 14530020 LA GR1,64 LENGTH OF MESSAGE IN BYTES. 14540020 BC 15,TYPEWAIT GO TO TYPE MESSAGE//WAIT ROUTINE 14550020 SPACE 1 14560020 ERR236 BC 15,OVRRUN GO TO OVERRUN CHECK ROUTINE 14570020 SPACE 1 14580020 ERR237 BC 15,COMREJ GO TO COMMAND REJECT ROUTINE 14590020 SPACE 1 14600020 ERR238 BC 15,ENDTEST GO TO END OF TEST ROUTINE 14610020 EJECT 14620020 * **************************************************** 14630020 * * FOLLOWING ROUTINES FOR 2400 MAGNETIC TAPE UNIT * 14640020 * **************************************************** 14650020 SPACE 2 14660020 * 2400 TEST CHANNEL STATUS BYTES ROUTINE 14670020 SPACE 2 14680020 ERR300 BAL ERRLNK,ERRTEST LINK TO STATUS/SENSE TEST RTN. 14690020 DC X'1D' CHANNEL CONTROL CHECK 14700020 DC AL1(ERR301-ERR300-4) 14710020 DC X'1E' INTERFACE CONTROL CHECK 14720020 DC AL1(ERR302-ERR300-6) 14730020 DC X'1C' CHANNEL DATA CHECK 14740020 DC AL1(ERR303-ERR300-8) 14750020 DC X'10' SHOULD NOT OCCUR 14760020 DC AL1(ERR304-ERR300-10) 14770020 DC X'16' UNIT CHECK 14780020 DC AL1(ERR330-ERR300-12) 14790020 DC X'1F' CHAINING CHECK 14800020 DC AL1(ERR305-ERR300-14) 14810020 DC X'1A' PROGRAM CHECK 14820020 DC AL1(ERR306-ERR300-16) 14830020 DC X'1B' PROTECTION CHECK 14840020 DC AL1(ERR307-ERR300-18) 14850020 DC X'17' UNIT EXCEPTION 14860020 DC AL1(ERR308-ERR300-20) 14870020 DC X'19' INCORRECT LENGTH 14880020 DC AL1(ERR309-ERR300-22) 14890020 DC X'2F' END OF TEST 14900020 DC AL1(ERR310-ERR300-24) 14910020 SPACE 2 14920020 * 2400 TEST CHANNEL SENSE BYTES ROUTINE. 14930020 SPACE 2 14940020 ERR330 BAL ERRLNK,ERRTEST LINK TO STATUS/SENSE BYTES TEST. 14950020 DC X'02' BUS OUT CHECK 14960020 DC AL1(ERR334-ERR330-4) 14970020 DC X'03' EQUIPMENT CHECK 14980020 DC AL1(ERR332-ERR330-6) 14990020 DC X'01' INTERVENTION REQ 15000020 DC AL1(ERR333-ERR330-8) 15010020 DC X'05' OVER RUN 15020020 DC AL1(ERR336-ERR330-10) 15030020 DC X'08' NOISE 15040020 DC AL1(ERR331-ERR330-12) 15050020 DC X'04' DATA CHECK 15060020 DC AL1(ERR335-ERR330-14) 15070020 DC X'07' DATA CONVERT CHECK 15080020 DC AL1(ERR337-ERR330-16) 15090020 DC X'00' COMMAND REJECT 15100020 DC AL1(ERR338-ERR330-18) 15110020 DC X'0C' TAPE AT LOAD POINT 15120020 DC AL1(ERR339-ERR330-20) 15130020 DC X'2F' END OF TEST 15140020 DC AL1(ERR340-ERR330-22) 15150020 SPACE 2 15160020 * EXITS TO 2400 ERROR RECOVERY ROUTINES. 15170020 SPACE 2 15180020 ERR301 BC 15,CHANERR GO TO CHANNEL CONTROL CHECK RTN. 15190020 SPACE 1 15200020 ERR302 BC 15,INFCERR GO TO INTERFACE CONTROL CHECK 15210020 SPACE 1 15220020 ERR303 BC 15,CHDATA GO TO CHANNEL DATA CHECK ROUTINE 15230020 SPACE 1 15240020 ERR304 BC 15,NEVER GO TO SHOULD NOT OCCUR ROUTINE 15250020 SPACE 1 15260020 ERR305 BAL LINK15,BACKSPC GO TO BACKSPACE ROUTINE 15270020 BAL LINK15,SIXTRY RETRY ERROR CCW LIST 6 TIMES. 15280020 BC 15,CHAINCHK SOLID ERROR-GO TO CHAINCHK RTN. 15290020 SPACE 1 15300020 ERR306 BC 15,PROCHK GO TO PROGRAM CHECK ROUTINE 15310020 SPACE 1 15320020 ERR307 BC 15,PTNCHK GO TO PROTECTION CHECK ROUTING 15330020 SPACE 1 15340020 ERR308 BC 15,UNITCEPT GO TO UNIT EXCEPTION ROUTINE. 15350020 SPACE 1 15360020 ERR309 BC 15,WLRERR GO TO INCORRECT LENGTH ROUTINE 15370020 SPACE 1 15380020 ERR310 BC 15,ENDTEST GO TO END OF TEST ROUTINE 15390020 SPACE 1 15400020 ERR331 BC 15,NOISETST TEST FOR NOISE RECORD ROUTINE. 15410020 SPACE 1 15420020 ERR332 BC 15,EQUIPCHK GO TO EQUIPMENT CHECK ROUTINE 15430020 SPACE 1 15440020 ERR333 BAL LINK15,INTVREQ LINK TO INTERVENTION REQ ROUTINE 15450020 MVC READYDEV(27),TAPEMSG INSERT DISKMSG//CLEAR CUU FIELD. 15460020 MVC READYDEV+20(3),IOCONV+1 SET DEVICE ADDR. IN OPR MESSAGE. 15470020 B DEVWAIT GO TO DEVICE WAIT ROUTINE. 15480020 SPACE 1 15490020 ERR334 BAL LINK15,BACKSPC BACKSPACE THE TAPE ONE RECORD. 15500020 BAL LINK15,TWOTRY RETRY ERROR CCW LIST ONCE MORE. 15510020 BC 15,BUSOUT SOLID ERROR-GO TO BUSOUT ROUTINE 15520020 SPACE 1 15530020 ERR335 BC 15,TAPEDATA TEST READ OR WRITE OPERATION 15540020 SPACE 1 15550020 ERR336 BAL LINK15,BACKSPC LINK TO TAPE BACKSPACE ROUTINE 15560020 BAL LINK15,SIXTRY RETRY ERROR CCW UP TO SIX TIMES 15570020 BC 15,OVRRUN SOLID ERROR-GO TO OVERRUN RTN. 15580020 SPACE 1 15590020 ERR337 BC 15,CONVTERR GO TO DATA CONVERT ERROR ROUTINE 15600020 SPACE 1 15610020 ERR338 TM 25(UCBREG),X'02' DID FILE PROTECT OCCUR ALSO. 15620020 BC 1,FILEPROT YES..GO TO FILE PROTECTED RTN. 15630020 BC 14,COMREJ NO...GO TO COMMAND REJECT RTN. 15640020 SPACE 1 15650020 ERR339 BC 15,TAPELP GO TO LOAD POINT ERROR RTN. 15660020 SPACE 1 15670020 ERR340 BC 15,ENDTEST GO TO END OF TEST ROUTINE 15680020 EJECT 15690020 * ********************************************* 15700020 * * FOLLOWING ROUTINES USED BY 1403 PRINTER * 15710020 * ********************************************* 15720020 SPACE 2 15730020 * 1403 TEST CHANNEL STATUS BYTES ROUTINE. 15740020 SPACE 2 15750020 ERR400 BAL ERRLNK,ERRTEST LINK TO STATUS/SENSE BYTES TEST. 15760020 DC X'1D' CHANNEL CONTORL CHECK 15770020 DC AL1(ERR401-ERR400-4) 15780020 DC X'1E' INTERFACE CONTROL CHECK 15790020 DC AL1(ERR402-ERR400-6) 15800020 DC X'1C' CHANNEL DATA CHECK 15810020 DC AL1(ERR403-ERR400-8) 15820020 DC X'10' SHOULD NOT OCCUR 15830020 DC AL1(ERR404-ERR400-10) 15840020 DC X'11' SHOULD NOT OCCUR 15850020 DC AL1(ERR404-ERR400-12) 15860020 DC X'12' SHOULD NOT OCCUR 15870020 DC AL1(ERR404-ERR400-14) 15880020 DC X'1F' SHOULD NOT OCCUR 15890020 DC AL1(ERR404-ERR400-16) 15900020 DC X'16' UNIT CHECK 15910020 DC AL1(ERR430-ERR400-18) 15920020 DC X'1A' PROGRAM CHECK 15930020 DC AL1(ERR405-ERR400-20) 15940020 DC X'1B' PROTECTION CHECK 15950020 DC AL1(ERR406-ERR400-22) 15960020 DC X'17' UNIT EXCEPTION 15970020 DC AL1(ERR407-ERR400-24) 15980020 DC X'19' INCORRECT LENGTH 15990020 DC AL1(ERR408-ERR400-26) 16000020 DC X'2F' END OF TEST 16010020 DC AL1(ERR409-ERR400-28) 16020020 SPACE 2 16030020 * 1403 TEST CHANNEL SENSE BYTES ROUTINE. 16040020 SPACE 1 16050020 ERR430 BAL ERRLNK,ERRTEST LINK TO STATUS/SENSE BYTES TEST. 16060020 DC X'04' SHOULD NOT OCCUR 16070020 DC AL1(ERR431-ERR430-4) 16080020 DC X'05' SHOULD NOT OCCUR 16090020 DC AL1(ERR431-ERR430-6) 16100020 DC X'06' SHOULD NOT OCCUR 16110020 DC AL1(ERR431-ERR430-8) 16120020 DC X'03' EQUIPMENT CHECK 16130020 DC AL1(ERR432-ERR430-10) 16140020 DC X'01' INTERVENTION REQUIRED 16150020 DC AL1(ERR433-ERR430-12) 16160020 DC X'02' BUS OUT CHECK 16170020 DC AL1(ERR434-ERR430-14) 16180020 DC X'07' CHANNEL 9 16190020 DC AL1(ERR435-ERR430-16) 16200020 DC X'00' COMMAND REJECT 16210020 DC AL1(ERR436-ERR430-18) 16220020 DC X'2F' END OF TEST 16230020 DC AL1(ERR437-ERR430-20) 16240020 SPACE 1 16250020 * EXITS TO 1403 ERROR RECOVERY ROUTINES. 16260020 SPACE 1 16270020 ERR401 BC 15,CHANERR GO TO CHANNEL ERROR ROUTINE 16280020 SPACE 1 16290020 ERR402 BC 15,INFCERR GO TO INTERFACE ERROR ROUTINE 16300020 SPACE 1 16310020 ERR403 BC 15,CHDATA GO TO CHANNEL DATA ERROR ROUTINE 16320020 SPACE 1 16330020 ERR404 BC 15,NEVER GO TO SHOULD NOT OCCUR ROUTINE 16340020 SPACE 1 16350020 ERR405 BC 15,PROCHK GO TO PROGRAM CHECK ROUTINE 16360020 SPACE 1 16370020 ERR406 BC 15,PTNCHK GO TO PROTECTION CHECK ROUTINE 16380020 SPACE 1 16390020 ERR407 BC 15,SKIPTO1 GO TO CARRIAGE SKIP TO 1 ROUTINE 16400020 SPACE 1 16410020 ERR408 BC 15,WLRERR GO TO INCORRECT LENGTH ROUTINE 16420020 SPACE 1 16430020 ERR409 BC 15,ENDTEST GO TO END OF TEST ROUTINE 16440020 SPACE 1 16450020 ERR431 BC 15,NEVER GO TO SHOULD NOT OCCUR ROUTINE 16460020 SPACE 1 16470020 ERR432 LA GR2,PRINTCHK ADDRESS OF PRINT CHECK MESSAGE. 16480020 LA GR1,59 LENGTH OF MESSAGE IN BYTES. 16490020 BC 15,TYPEWAIT GO TO PRINT OPERATOR MSG//WAIT// 16500020 SPACE 1 16510020 ERR433 LA GR7,UCBSYO GET ADDRESS OF SYSOUT DEVICE. 16520020 BAL LINK15,UNITADDR CONVERT HEX UNIT ADDRESS TO BCD. 16530020 MVC READYDEV(27),READYPRT INSERT READYPRT//CLEAR CUU FIELD 16540020 MVC READYDEV+23(3),UNITBUF+1 INSERT DEVICE ADDR IN MESSAGE. 16550020 B DEVWAIT GO TO DEVICE WAIT ROUTINE. 16560020 SPACE 1 16570020 ERR434 BAL LINK15,TWOTRY RETRY ERROR CCW LIST ONCE MORE. 16580020 BC 15,BUSOUT SOLID ERROR-GO TO BUSOUT RTN. 16590020 SPACE 1 16600020 ERR435 MVC REGSV5(64),ERRSAV1 RESTORE ORIGINAL P/P REGISTERS. 16610020 B IORTRN CHANNEL NINE SENSED//RETURN 16620020 SPACE 1 16630020 ERR436 BC 15,COMREJ GO TO COMMAND REJECT ROUTINE 16640020 SPACE 1 16650020 ERR437 BC 15,ENDTEST GO TO END OF TEST ROUTINE 16660020 EJECT 16670020 * ***************************************************** 16680020 * * FOLLOWING ROUTINES USED BY 1052,2150 I/O WRITERS * 16690020 * ***************************************************** 16700020 SPACE 2 16710020 * 1052 I/O WRITER TEST CHANNEL STATUS BYTES ROUTINE. 16720020 SPACE 2 16730020 ERR500 BAL ERRLNK,ERRTEST LINK TO STATUS/SENSE BYTES TEST. 16740020 DC X'1D' CHANNEL CONTROL CHECK 16750020 DC AL1(ERR501-ERR500-4) 16760020 DC X'1E' INTERFACE CONTROL CHECK 16770020 DC AL1(ERR502-ERR500-6) 16780020 DC X'1C' CHANNEL DATA CHECK 16790020 DC AL1(ERR503-ERR500-8) 16800020 DC X'11' SHOULD NOT OCCUR 16810020 DC AL1(ERR504-ERR500-10) 16820020 DC X'12' SHOULD NOT OCCUR 16830020 DC AL1(ERR504-ERR500-12) 16840020 DC X'16' UNIT CHECK 16850020 DC AL1(ERR530-ERR500-14) 16860020 DC X'1F' CHAINING CHECK 16870020 DC AL1(ERR505-ERR500-16) 16880020 DC X'1A' PROGRAM CHECK 16890020 DC AL1(ERR506-ERR500-18) 16900020 DC X'1B' PROTECTION CHECK 16910020 DC AL1(ERR507-ERR500-20) 16920020 DC X'17' UNIT EXCEPTION 16930020 DC AL1(ERR508-ERR500-22) 16940020 DC X'19' INCORRECT LENGTH 16950020 DC AL1(ERR509-ERR500-24) 16960020 DC X'2F' END OF TEST 16970020 DC AL1(ERR510-ERR500-26) 16980020 SPACE 2 16990020 * 1052 I/O WRITER TEST CHANNEL SENSE BYTES ROUTINE. 17000020 SPACE 2 17010020 ERR530 BAL ERRLNK,ERRTEST LINK TO STATUS/SENSE BYTES TEST. 17020020 DC X'07' SHOULD NOT OCCUR 17030020 DC AL1(ERR531-ERR530-4) 17040020 DC X'06' SHOULD NOT OCCUR 17050020 DC AL1(ERR531-ERR530-6) 17060020 DC X'05' SHOULD NOT OCCUR 17070020 DC AL1(ERR531-ERR530-8) 17080020 DC X'04' SHOULD NOT OCCUR 17090020 DC AL1(ERR531-ERR530-10) 17100020 DC X'03' EQUIPMENT CHECK 17110020 DC AL1(ERR532-ERR530-12) 17120020 DC X'01' INTERVENTION REQUIRED 17130020 DC AL1(ERR533-ERR530-14) 17140020 DC X'02' BUS OUT CHECK 17150020 DC AL1(ERR534-ERR530-16) 17160020 DC X'00' COMMAND REJECT 17170020 DC AL1(ERR535-ERR530-18) 17180020 DC X'2F' END OF TEST 17190020 DC AL1(ERR536-ERR530-20) 17200020 SPACE 1 17210020 * EXIT TO 1052 I/O WRITER ERROR RECOVERY ROUTINES. 17220020 SPACE 1 17230020 ERR501 BC 15,CHANERR GO TO CHANNEL CONTROL ERROR RTN. 17240020 SPACE 1 17250020 ERR502 BC 15,INFCERR GO TO INTERFACE CONTROL CHECK 17260020 SPACE 1 17270020 ERR503 BC 15,CHDATA GO TO CHANNEL DATA CHECK ROUTINE 17280020 SPACE 1 17290020 ERR504 BC 15,NEVER GO TO SHOULD NOT OCCUR ROUTINE 17300020 SPACE 1 17310020 ERR505 BC 15,CHAINCHK GO TO CHAINING CHECK ROUTINE 17320020 SPACE 1 17330020 ERR506 BC 15,PROCHK GO TO PROGRAM CHECK ROUTINE 17340020 SPACE 1 17350020 ERR507 BC 15,PTNCHK GO TO PROTECTION CHECK ROUTINE 17360020 SPACE 1 17370020 ERR508 LM 0,15,ERRSAV1 RESTORE REGS TO RETRY TYPER CCW. 17380020 TM EDJTSW,X'01' IS END OF TASK SW ON 17390020 BO EDJTF YES, GO TO END OF JOB 17400020 B ATTN RETRY THE TYPERWRITER AGAIN. 17410020 SPACE 1 17420020 ERR509 BC 15,WLRERR GO TO INCORRECT LENGTH ROUTINE 17430020 SPACE 1 17440020 ERR510 BC 15,ENDTEST GO TO END OF TEST ROUTINE 17450020 SPACE 1 17460020 ERR531 BC 15,NEVER GO TO SHOULD NOT OCCUR ROUTINE 17470020 SPACE 1 17480020 ERR532 TM 8(UCBREG),X'01' TYPER IN READ OR WRITE STATUS. 17490020 BC 14,FAILREAD READ STATUS--PRINT MESSAGE//WAIT 17500020 BAL LINK15,TWOTRY WRITE STATUS--RETRY TYPER CCW. 17510020 B WAITTRY GO TO WAIT//RETRY CCW ROUTINE. 17520020 FAILREAD LA GR2,TYPEFAIL ADDR OF I/OWRITER READ ERROR MSG 17530020 LA GR1,72 LENGTH OF MESSAGE IN BYTES. 17540020 BC 15,TYPEWAIT GO TO TYPE MESSAGE//WAIT ROUTINE 17550020 SPACE 1 17560020 ERR533 B WAITTRY GO TO RETRY THE CCW. 17570020 SPACE 1 17580020 ERR534 BAL LINK15,TWOTRY RETRY ERROR CCW LIST ONCE MORE. 17590020 BC 15,BUSOUT SOLID ERROR-GO TO BUSOUT ROUTINE 17600020 SPACE 1 17610020 ERR535 BC 15,COMREJ GO TO COMMAND REJECT ROUTINE 17620020 SPACE 1 17630020 ERR536 BC 15,ENDTEST GO TO END OF TEST ROUTINE 17640020 EJECT 17650020 * * ****************************************** 17660020 * * FOLLOWING ROUTINES USED BY 1402 READER * 17670020 * ******************************************** 17680020 SPACE 2 17690020 * 1402 TEST CHANNEL STATUS BYTES ROUTINE. 17700020 SPACE 2 17710020 ERR600 BAL ERRLNK,ERRTEST LINK TO STATUS/SENSE BYTES TEST. 17720020 DC X'1D' CHANNEL CONTROL CHECK 17730020 DC AL1(ERR601-ERR600-4) 17740020 DC X'1E' INTERFACE CONTROL CHECK 17750020 DC AL1(ERR602-ERR600-6) 17760020 DC X'1C' CHANNEL DATA CHECK 17770020 DC AL1(ERR603-ERR600-8) 17780020 DC X'10' SHOULD NOT OCCUR 17790020 DC AL1(ERR604-ERR600-10) 17800020 DC X'11' SHOULD NOT OCCUR 17810020 DC AL1(ERR604-ERR600-12) 17820020 DC X'12' SHOULD NOT OCCUR 17830020 DC AL1(ERR604-ERR600-14) 17840020 DC X'1F' SHOULD NOT OCCUR 17850020 DC AL1(ERR604-ERR600-16) 17860020 DC X'16' UNIT CHECK 17870020 DC AL1(ERR630-ERR600-18) 17880020 DC X'1A' PROGRAM CHECK 17890020 DC AL1(ERR605-ERR600-20) 17900020 DC X'1B' PROTECTION CHECK 17910020 DC AL1(ERR606-ERR600-22) 17920020 DC X'17' UNIT EXCEPTION 17930020 DC AL1(ERR607-ERR600-24) 17940020 DC X'19' INCORRECT LENGTH 17950020 DC AL1(ERR608-ERR600-26) 17960020 DC X'2F' END OF TEST 17970020 DC AL1(ERR609-ERR600-28) 17980020 SPACE 1 17990020 * 1402 TEST CHANNEL SENSE BYTES ROUTINE. 18000020 SPACE 1 18010020 ERR630 BAL ERRLNK,ERRTEST LINK TO STATUS/SENSE TEST RTN. 18020020 DC X'05' SHOULD NOT OCCUR 18030020 DC AL1(ERR631-ERR630-4) 18040020 DC X'07' SHOULD NOT OCCUR 18050020 DC AL1(ERR631-ERR630-6) 18060020 DC X'03' EQUIPMENT CHECK 18070020 DC AL1(ERR632-ERR630-8) 18080020 DC X'01' INTERVENTION REQUIRED 18090020 DC AL1(ERR633-ERR630-10) 18100020 DC X'02' BUS OUT CHECK 18110020 DC AL1(ERR634-ERR630-12) 18120020 DC X'04' DATA CHECK 18130020 DC AL1(ERR635-ERR630-14) 18140020 DC X'00' COMMAND REJECT 18150020 DC AL1(ERR636-ERR630-16) 18160020 DC X'06' UNUSUAL COMMAND SEQUENCE 18170020 DC AL1(ERR637-ERR630-18) 18180020 DC X'2F' END OF TEST 18190020 DC AL1(ERR638-ERR630-20) 18200020 SPACE 1 18210020 * EXITS TO 1402 ERROR RECOVERY ROUTINES. 18220020 SPACE 1 18230020 ERR601 BC 15,CHANERR GO TO CHANNEL CONTROL ERROR RTN. 18240020 SPACE 1 18250020 ERR602 BC 15,INFCERR GO TO INTERFACE CONTROL ERROR 18260020 SPACE 1 18270020 ERR603 BC 15,CHDATA GO TO CHANNEL DATA ERROR ROUTINE 18280020 SPACE 1 18290020 ERR604 BC 15,NEVER GO TO SHOULD NOT OCCUR ROUTINE 18300020 SPACE 1 18310020 ERR605 BC 15,PROCHK GO TO PROGRAM CHECK ROUTINE 18320020 SPACE 1 18330020 ERR606 BC 15,PTNCHK GO TO PROTECTION CHECK ROUTINE 18340020 SPACE 1 18350020 ERR607 BC 15,UNITCEPT GO TO UNIT EXCEPTION ROUTINE 18360020 SPACE 1 18370020 ERR608 BC 15,WLRERR GO TO INCORRECT LENGTH ROUTINE 18380020 SPACE 1 18390020 ERR609 BC 15,ENDTEST GO TO END OF TEST ROUTINE 18400020 SPACE 1 18410020 ERR631 BC 15,NEVER GO TO SHOULD NOT OCCUR ROUTINE 18420020 SPACE 1 18430020 ERR632 LA GR2,READCHK ADDRESS OF READER CHECK MESSAGE. 18440020 LA GR1,60 LENGTH OF MESSAGE IN BYTES 18450020 BC 15,TYPEWAIT GO TO TYPE MESSAGE//WAIT ROUTINE 18460020 SPACE 1 18470020 ERR633 BAL LINK15,INTVREQ LINK//INTERVENTION REQUIRED RTN. 18480020 MVC READYDEV(27),READYRDR INSERT READYRDR/CLEAR CUU FIELD. 18490020 MVC READYDEV+22(3),IOCONV+1 SET DEVICE ADDR. IN OPR MESSAGE. 18500020 B DEVWAIT GO TO DEVICE WAIT ROUTINE. 18510020 SPACE 1 18520020 ERR634 BAL LINK15,TWOTRY RETRY ERROR CCW LIST ONCE MORE. 18530020 BC 15,BUSOUT SOLID ERROR-GO TO BUSOUT ROUTINE 18540020 SPACE 1 18550020 ERR635 LA GR2,INVALCRD ADDRESS OF INVALID CARD CODE MSG 18560020 LA GR1,64 LENGTH OF MESSAGE. 18570020 BC 15,TYPEWAIT GO TO TYPE MESSAGE//WAIT ROUTINE 18580020 SPACE 1 18590020 ERR636 BC 15,COMREJ GO TO COMMAND REJECT ROUTINE 18600020 SPACE 1 18610020 ERR637 BC 15,SEQERR GO TO UNUSUAL COMMAND SEQ. RTN. 18620020 SPACE 1 18630020 ERR638 BC 15,ENDTEST GO TO END OF TEST ROUTINE 18640020 EJECT 18650020 * ************************************************ 18660020 * * FOLLOWING ROUTINE USED BY 2301 DASD DEVICE * 18670020 * ************************************************ 18680020 SPACE 2 18690020 * 2301 TEST CHANNEL SENSE BYTES ROUTINE. 18700020 SPACE 2 18710020 ERR730 BAL ERRLNK,ERRTEST LINK TO STATUS/SENSE BYTES TEST. 18720020 DC X'03' EQUIPMENT CHECK. 18730020 DC AL1(ERR732-ERR730-4) 18740020 DC X'0C' NO RECORD FOUND. 18750020 DC AL1(ERR741-ERR730-6) 18760020 DC X'07' INVALID ADDRESS. 18770020 DC AL1(ERR738-ERR730-8) 18780020 DC X'01' INTERVENTION REQUIRED. 18790020 DC AL1(ERR733-ERR730-10) 18800020 DC X'02' BUS OUT CHECK. 18810020 DC AL1(ERR734-ERR730-12) 18820020 DC X'04' DATA CHECK. 18830020 DC AL1(ERR735-ERR730-14) 18840020 DC X'05' OVERRUN. 18850020 DC AL1(ERR736-ERR730-16) 18860020 DC X'00' COMMAND REJECT. 18870020 DC AL1(ERR737-ERR730-18) 18880020 DC X'06' SHOULD NOT OCCUR. 18890020 DC AL1(ERR731-ERR730-20) 18900020 DC X'09' TRACK OVERRUN. 18910020 DC AL1(ERR739-ERR730-22) 18920020 DC X'0A' END OF CYLINDER. 18930020 DC AL1(ERR740-ERR730-24) 18940020 DC X'0D' FILE PROTECTED 18950020 DC AL1(ERR742-ERR730-26) 18960020 DC X'0F' OVERFLOW INCOMPLETE 18970020 DC AL1(ERR743-ERR730-28) 18980020 DC X'2F' END OF TEST 18990020 DC AL1(ERR744-ERR730-30) 19000020 SPACE 2 19010020 * EXITS TO 2301 ERROR RECOVERY ROUTINES. 19020020 SPACE 2 19030020 ERR731 BC 15,NEVER GO TO SHOULD NOT OCCUR ROUTINE 19040020 SPACE 1 19050020 ERR732 BAL LINK15,TWOTRY RETRY ERROR CCW LIST ONCE MORE. 19060020 BC 15,EQUIPCHK SOLID ERROR-GO TO EQUIPCHK RTN. 19070020 SPACE 1 19080020 ERR733 B ERR133 GO TO 2302 INTERVENTION REQ RTN. 19090020 SPACE 1 19100020 ERR734 BAL LINK15,TWOTRY RETRY ERROR CCW LIST ONCE MORE. 19110020 BC 15,BUSOUT SOLID ERROR-GO TO BUSOUT RTN. 19120020 SPACE 1 19130020 ERR735 B ERR135 SAME AS 2311 DATA CHECK 19140020 SPACE 1 19150020 ERR736 BAL LINK15,SIXTRY RETRY ERROR CCW LIST SIX TIMES. 19160020 BC 15,OVRRUN SOLID ERROR-GO TO OVRRUN ROUTINE 19170020 SPACE 1 19180020 ERR737 BC 15,COMREJ GO TO COMMAND REJECT ROUTINE 19190020 SPACE 1 19200020 ERR738 BC 15,INVLDADR GO TO INVALID ADDRESS ROUTINE 19210020 SPACE 1 19220020 ERR739 BC 15,TROVRRUN GO TO TRACK OVERRUN ROUTINE 19230020 SPACE 1 19240020 ERR740 BC 15,ENDOFCYL GO TO END OF CYLINDER ROUTINE 19250020 SPACE 1 19260020 ERR741 BC 15,NORECFND GO TO RECORD FOUND ROUTINE 19270020 SPACE 1 19280020 ERR742 BC 15,FILEPROT GO TO FILE PROTECTED ROUTINE 19290020 SPACE 1 19300020 ERR743 BC 15,OVRFLOW GO TO OVERFLOW INCOMPLETE RTN. 19310020 SPACE 1 19320020 ERR744 BC 15,ENDTEST GO TO END OF TEST ROUTINE 19330020 EJECT 19340020 * ********************************************* 19350020 * * FOLLOWING ROUTINES USED BY 1443 PRINTER * 19360020 * ********************************************* 19370020 SPACE 2 19380020 * 1443 TEST CHANNEL STATUS BYTES ROUTINE. 19390020 SPACE 2 19400020 ERR800 BAL ERRLNK,ERRTEST LINK TO STATUS/SENSE BYTES TEST. 19410020 DC X'1D' CHANNEL CONTROL CHECK 19420020 DC AL1(ERR801-ERR800-4) 19430020 DC X'1E' INTERFACE CONTROL CHECK 19440020 DC AL1(ERR802-ERR800-6) 19450020 DC X'1C' CHANNEL DATA CHECK 19460020 DC AL1(ERR803-ERR800-8) 19470020 DC X'10' SHOULD NOT OCCUR 19480020 DC AL1(ERR804-ERR800-10) 19490020 DC X'11' SHOULD NOT OCCUR 19500020 DC AL1(ERR804-ERR800-12) 19510020 DC X'12' SHOULD NOT OCCUR 19520020 DC AL1(ERR804-ERR800-14) 19530020 DC X'1F' SHOULD NOT OCCUR 19540020 DC AL1(ERR804-ERR800-16) 19550020 DC X'16' UNIT CHECK 19560020 DC AL1(ERR830-ERR800-18) 19570020 DC X'1A' PROGRAM CHECK 19580020 DC AL1(ERR805-ERR800-20) 19590020 DC X'1B' PROTECTION CHECK 19600020 DC AL1(ERR806-ERR800-22) 19610020 DC X'17' UNIT EXCEPTION 19620020 DC AL1(ERR807-ERR800-24) 19630020 DC X'19' INCORRECT LENGTH 19640020 DC AL1(ERR808-ERR800-26) 19650020 DC X'2F' END OF TEST 19660020 DC AL1(ERR809-ERR800-28) 19670020 SPACE 2 19680020 * 1443 TEST CHANNEL SENSE BYTES ROUTINE. 19690020 SPACE 2 19700020 ERR830 BAL ERRLNK,ERRTEST LINK TO STATUS/SENSE BYTES TEST. 19710020 DC X'06' SHOULD NOT OCCUR 19720020 DC AL1(ERR831-ERR830-4) 19730020 DC X'03' EQUIPMENT CHECK 19740020 DC AL1(ERR832-ERR830-6) 19750020 DC X'01' INTERVENTION REQUIRED 19760020 DC AL1(ERR833-ERR830-8) 19770020 DC X'02' BUS OUT ON INITIAL SELECTION 19780020 DC AL1(ERR834-ERR830-10) 19790020 DC X'07' CHANNEL 9 19800020 DC AL1(ERR835-ERR830-12) 19810020 DC X'00' COMMAND REJECT 19820020 DC AL1(ERR836-ERR830-14) 19830020 DC X'2F' END OF TEST 19840020 DC AL1(ERR837-ERR830-16) 19850020 SPACE 2 19860020 * EXITS TO 1443 ERROR RECOVERY ROUTINES. 19870020 SPACE 2 19880020 ERR801 BC 15,CHANERR GO TO CHANNEL ERROR ROUTINE 19890020 SPACE 1 19900020 ERR802 BC 15,INFCERR GO TO INTERFACE ERROR ROUTINE 19910020 SPACE 1 19920020 ERR803 BC 15,CHDATA GO TO CHANNEL DATA ERROR ROUTIN 19930020 SPACE 1 19940020 ERR804 BC 15,NEVER GO TO SHOULD NOT OCCUR ROUTINE 19950020 SPACE 1 19960020 ERR805 BC 15,PROCHK GO TO PROGRAM CHECK ROUTINE 19970020 SPACE 1 19980020 ERR806 BC 15,PTNCHK GO TO PROTECTION CHECK ROUTINE 19990020 SPACE 1 20000020 ERR807 BC 15,SKIPTO1 GO TO CARRIAGE SKIP TO 1 ROUTINE 20010020 SPACE 1 20020020 ERR808 BC 15,WLRERR GO TO INCORRECT LENGTH ROUTINE 20030020 SPACE 1 20040020 ERR809 BC 15,ENDTEST GO TO END OF TEST ROUTINE 20050020 SPACE 1 20060020 ERR831 BC 15,NEVER GO TO SHOULD NOT OCCUR ROUTINE 20070020 SPACE 1 20080020 ERR832 LA GR2,PRINTCHK ADDRESS OF PRINT CHECK MESSAGE. 20090020 LA GR1,59 LENGTH OF MESSAGE IN BYTES. 20100020 BC 15,TYPEWAIT GO TO PRINT OPERATOR MSG//WAIT// 20110020 SPACE 1 20120020 ERR833 LA GR7,UCBSYO GET ADDRESS OF SYSOUT DEVICE. 20130020 BAL LINK15,UNITADDR CONVERT HEX UNIT ADDRESS TO BCD. 20140020 MVC READYDEV(27),READYPRT INSERT READYPRT//CLEAR CUU FIELD 20150020 MVC READYDEV+23(3),UNITBUF+1 INSERT DEVICE ADDR IN MESSAGE. 20160020 B DEVWAIT GO TO DEVICE WAIT ROUTINE. 20170020 SPACE 1 20180020 ERR834 BAL LINK15,TWOTRY RETRY ERROR CCW LIST ONCE MORE. 20190020 BC 15,BUSOUT SOLID ERROR-GO TO BUSOUT RTN 20200020 SPACE 1 20210020 ERR835 MVC REGSV5(64),ERRSAV1 RESTORE ORIGINAL P/P REGISTERS. 20220020 B IORTRN CHANNEL NINE SENSED//RETURN 20230020 SPACE 1 20240020 ERR836 BC 15,COMREJ GO TO COMMAND REJECT ROUTINE 20250020 ERR837 B ENDTEST 20260020 EJECT 20270020 *********************************************************** 20280020 * FOLLOWING ROUTINES USED BY 3330 AND 2305 * 20290020 *********************************************************** 20300020 ERRB00 CLI L0(UCBREG),T3330 IS DEVICE A 3330 S20201 20310020 BNE ERRB01 NO - CHECK 2305 S20201 20320020 TM TWOSIX(UCBREG),TEN CHECK FOR ENV DATA S20201 20330020 BO ENVDATA BR IF PRESENT S20201 20340020 B ERRA00 CHECK REST OF SENSE S20201 20350020 ENVDATA BAL LINK15,TWOTRY RETRY CCW TWO TIMES S20201 20360020 B ERRA00 CHECK REST OF SENSE S20201 20370020 ERRB01 TM TWOSIX(UCBREG),EIGHTY CHECK FOR BUFLOG FULL S20201 20380020 BO RDBUFLOG IF ON READ BUFFER LOG S20201 20390020 B ERRA00 CHECK REST OF SENSE S20201 20400020 RDBUFLOG MVC SAVECCW(L2),L6(UCBREG) SAVE CCW IN ERROR S20201 20410020 LA RCAW,BUFCCW READ BUFFER LOG CCW S20201 20420020 BAL LINK9,STARTIO START THE IO S20201 20430020 MVC L6(L2,UCBREG),SAVECCW RESTORE CCW IN ERROR S20201 20440020 BAL LINK15,TWOTRY RETRY CCW TWO TIMES S20201 20450020 ERRA00 BAL ERRLNK,ERRTEST LINK TO SENSE BYTE TEST S20201 20460020 DC X'03' EQUIPMENT CHECK S20201 20470020 DC AL1(ERRA01-ERRA00-4) EQUIPMENT CHECK S20201 20480020 DC X'0C' NO RECORD FOUND S20201 20490020 DC AL1(ERRA02-ERRA00-6) NO RECORD FOUND S20201 20500020 DC X'01' INTERVENTION REQUIRED S20201 20510020 DC AL1(ERRA03-ERRA00-8) INTERVENTION REQUIRED S20201 20520020 DC X'02' BUS OUT CHECK S20201 20530020 DC AL1(ERRA04-ERRA00-10) BUS OUT CHECK S20201 20540020 DC X'05' OVERRUN S20201 20550020 DC AL1(ERRA06-ERRA00-12) OVERRUN S20201 20560020 DC X'00' COMMAND REJECT S20201 20570020 DC AL1(ERRA07-ERRA00-14) COMMAND REJECT S20201 20580020 DC X'0A' END OF CYLINDER S20201 20590020 DC AL1(ERRA08-ERRA00-16) END OF CYLINDER S20201 20600020 DC X'0D' FILE PROTECT S20201 20610020 DC AL1(ERRA09-ERRA00-18) FILE PROTECT S20201 20620020 DC X'0F' OPERATION INCOMPLETE S20201 20630020 DC AL1(ERRA10-ERRA00-20) OPERATION INCOMPLETE S20201 20640020 DC X'04' DATA CHECK S20201 20650020 DC AL1(ERRA05-ERRA00-22) DATA CHECK S20201 20660020 DC X'09' INVALID TRK FORMAT S20201 20670020 DC AL1(ERRA12-ERRA00-24) INVALID TRK FORMAT S20201 20680020 DC X'2F' END OF TEST S20201 20690020 DC AL1(ERRA13-ERRA00-28) END OF TEST S20201 20700020 ERRA01 B ERR131 USE 2311 EQUIPCHK RTN S20201 20710020 SPACE 1 20720020 ERRA02 B ERR132 GO TO NOREC FND RTN S20201 20730020 SPACE 1 20740020 ERRA03 B ERR133 GO TO DASD INT REQ RTN S20201 20750020 SPACE 1 20760020 ERRA04 B ERR134 USE 2311 BUS OUT RTN S20201 20770020 SPACE 1 20780020 ERRA05 TM 25(UCBREG),X'80' IS PERM ERROR ALSO S20201 20790020 BO DATACHK YES,TERMINATE S20201 20800020 B ERRPSD IGNORE CORRECTABLE ERROR M4946 20810020 SPACE 1 20820020 ERRA06 TM 25(UCBREG),X'80' IS PERM ERROR ALSO S20201 20830020 BO OVRRUN YES,BR TO TERMINATE S20201 20840020 B ERR137 USE 2311 OVERRUN RTN S20201 20850020 SPACE 1 20860020 ERRA07 B ERR138 USE 2311 COMMAND REJ RTN M0158 20870021 SPACE 1 20880020 ERRA08 B ENDOFCYL GO TO END OF CYL RTN S20201 20890020 SPACE 1 20900020 ERRA09 B ERR143 USE 2311 FILE PROT RTN S20201 20910020 SPACE 1 20920020 ERRA10 B ERR144 2311 DASD OVERFLOW RTN S20201 20930020 SPACE 1 20940020 ERRA12 B INTRKFMT BR TO INVALID TRK FMT S20201 20950020 SPACE 1 20960020 ERRA13 B ENDTEST BR TO END OF TEST RTN S20201 20970020 EJECT 20980020 * ************************************************* 20990020 * * FOLLOWING ROUTINES USED BY 2321 DASD DEVICE * 21000020 * ************************************************* 21010020 SPACE 2 21020020 * 2321 TEST CHANNEL SENSE BYTES ROUTINE 21030020 SPACE 2 21040020 ERR900 BAL ERRLNK,ERRTEST LINK TO STATUS/SENSE BYTE TEST 21050020 DC X'03' EQUIPMENT CHECK 21060020 DC AL1(ERR901-ERR900-4) 21070020 DC X'0C' NO RECORD FOUND 21080020 DC AL1(ERR902-ERR900-6) 21090020 DC X'07' SEEK CHECK 21100020 DC AL1(ERR903-ERR900-8) 21110020 DC X'01' INTERVENTION REQUIRED 21120020 DC AL1(ERR904-ERR900-10) 21130020 DC X'02' BUSS OUT CHECK 21140020 DC AL1(ERR905-ERR900-12) 21150020 DC X'04' DATA CHECK 21160020 DC AL1(ERR906-ERR900-14) 21170020 DC X'05' OVERRUN 21180020 DC AL1(ERR907-ERR900-16) 21190020 DC X'0E' MISSING ADDRESS MARKER 21200020 DC AL1(ERR908-ERR900-18) 21210020 DC X'00' COMMAND REJECT 21220020 DC AL1(ERR909-ERR900-20) 21230020 DC X'06' TRACK CONDITION CHECK 21240020 DC AL1(ERR910-ERR900-22) 21250020 DC X'09' TRACK OVERRUN 21260020 DC AL1(ERR911-ERR900-24) 21270020 DC X'0A' END OF CYLINDER 21280020 DC AL1(ERR912-ERR900-26) 21290020 DC X'0D' FILE PROTECT 21300020 DC AL1(ERR913-ERR900-28) 21310020 DC X'2F' END OF TEST 21320020 DC AL1(ERR914-ERR900-30) 21330020 SPACE 2 21340020 * EXITS TO 2321 ERROR RECOVERY ROUTINES 21350020 SPACE 2 21360020 ERR901 B EQUIPCHK GO TO EQUIPCHK ROUTINE 21370020 SPACE 1 21380020 ERR902 TM 25(UCBREG),X'02' MISSING ADDRESS PRESENT ALSO 21390020 BO ACTVIII YES, CHECK MORE 21400020 B ACTIX NO 21410020 SPACE 1 21420020 ERR903 TM 25(UCBREG),X'02' MISSING ADDRESS MARKER ALSO 21430020 BO BALLAST YES, SEEKED BALLAST-SOLID ERROR 21440020 B ACTXI CHECK ON SEEK CHECK 21450020 SPACE 1 21460020 ERR904 B ERR133 INTERV REQUIRED;AS IN 2311 21470020 SPACE 1 21480020 ERR905 BAL LINK15,TWOTRY BUS OUT--TRY ONCE MORE. 21490020 B BUSOUT SOLID ERROR--TERMINATE. 21500020 SPACE 1 21510020 ERR906 BAL LINK14,ACTXII DATA CHECK 21520020 B ALTE906 21530020 SPACE 1 21540020 ERR907 BAL LINK15,TENTRY 21550020 B OVRRUN 21560020 SPACE 1 21570020 ERR908 BAL LINK14,ACTXII MISSING ADDRESS MARLER 21580020 B MISSMARK 21590020 SPACE 1 21600020 ERR909 B COMREJ 21610020 SPACE 1 21620020 ERR910 CLC UCBTO+17(3),ADERASE OCCUR DURING ERASE. 21630020 BH IORTRN YES-RETURN//SEARCH ON BAD TRACK. 21640020 B TRACKCHK NO--GO HANDLE. 21650020 SPACE 1 21660020 ERR911 B TROVRRUN 21670020 SPACE 1 21680020 ERR912 B ENDOFCYL 21690020 SPACE 1 21700020 ERR913 B ERR143 FILE PROTECT 21710020 SPACE 1 21720020 ERR914 B ENDTEST 21730020 EJECT 21740020 ACTVIII TM ACTXIISW,X'40' ERROR CAUSED IN TEN TRY ROUTINE 21750020 BO TENTRY YES, TRY AGAIN IF NECESSARY 21760020 BAL LINK14,T3SEEK RESTORE//RETRY 3 TIMES. 21770020 L REGD,ERRSAV1+12 GET CCW ADDRESS 21780020 L REGD,0(REGD) GET SEEK ADDRESS 21790020 MVC STORSEEK(6),0(REGD) MOVE IT 21800020 XI STORSEEK+5,X'01' CHANGE TO ANOTHER TRACK CYLINDER 21810020 MVI ACTXIISW,X'10' RETURN WITHOUT CHECKING ERROR 21820020 LA GR3,SOMEHOME ADDRESS OF CCW LIST 21830020 BAL LINK9,STARTIO SEEK;READ HA OF NEW TRACK 21840020 CLC STORSEEK+2(4),HOMEBUF+1 WAS THIS PROPER TRACK 21850020 BE ACTVIIIE YES, RETRY ORIGINAL 21860020 BAL LINK9,STARTIO NO, TRY AGAIN 21870020 CLC STORSEEK+2(4),HOMEBUF+1 WAS THIS PROPER TRACK 21880020 BNE ACTVIIID NO--GO LOG AS BLANK TRACK. 21890020 ACTVIIIE MVI ACTXIISW,X'40' TELL ACTVIII WHERE WE ARE 21900020 MVC TENCTR(4),TENSET RESET THE TENTRY COUNTER. 21910020 BAL LINK15,TENTRY RETRY CCW LIST 10 TIMES 21920020 ACTVIIID MVI ACTXIISW,X'00' RESET SWITCH 21930020 L GR15,ERRSAV1+60 BLANK TRACK 21940020 ACTVIIIA IC REGD,0(GR15) INCRIMENT 21950020 LA REGD,1(REGD) BLANK TRACK 21960020 STC REGD,0(GR15) SWITCH 21970020 MVI ERRETRY,X'00' TURN OFF THE ERROR SWITCH. 21980020 * BAL LINK14,BLKTRACK LOG DATA FOR CE. 21990020 BAL LINK14,BLKTRCK1 LOG BLANK TRACK CONDITION. 22000020 CLI 0(GR15),X'03' THREE BLANK TRACKS 22010020 BE BLNKSTOP YES, PRINT MESSAGE - TERMIN 22020020 ACTVIIIF LM 0,15,ERRSAV1 RESTORE REGISTERS FOR RETUNR 22030020 MVI MFWANLX+4,X'20' RESET WRITE CCW 22040020 MVI ACTXIISW,X'00' TURN OFF ACTXIISW. 22050020 C GR15,ABLKTRK BLANK TRACK 22060020 BE TRKBLK YES REWRITE TRACK 22070020 ST RTRKADR,SAVERTRK WAS THIS ON 22080020 CLC SAVERTRK(2),L3050500 ALTERNATE STRIP 22090020 BL ACTVIIIG NO--REWRITE CYL/STRIP/SUBCELL. 22100020 MVI STRTADR+1,X'01' YES-RESET THE HA FLAG. 22110020 ACTVIIIG N RTRKADR,FFFFFF00 AT LEAST REWRITE CYLINDER. 22120020 C GR15,ABLKSTRP THIS A BLANK STRIP SITUATION. 22130020 BH WRITECT1 NO--BLANK CYLINDER. 22140020 BE ACTVIIIH YES-GO REWRITE THIS STRIP. 22150020 N RTRKADR,FF000000 NO--BLANK SUBCELL. 22160020 B WRITECT1 GO REWRITE THIS SUBCELL. 22170020 ACTVIIIH N RTRKADR,FFFF0000 SET TO REWRITE STRIP. 22180020 B WRITECT1 GO REWRITE THIS STRIP. 22190020 SPACE 1 22200020 SOMEHOME CCW 7,STORSEEK,X'60',6 22210020 CCW X'1F',SETFMK,X'40',1 22220020 CCW X'1A',HOMEBUF,X'20',5 22230020 SPACE 1 22240020 ACTIX BAL LINK15,CYLNCHK READ HA- SEE IF COREECT CYL 22250020 B ACTIXA NO 22260020 B NORECFND YES - HARD ERROR 22270020 ACTIXA BAL LINK14,ACTX SEEK ANOTHER STRIP 22280020 B NORECFND HARD ERROR 22290020 SPACE 1 22300020 ACTX LA GR3,RESEEKM GET ADDRESS OF CCW LIST 22310020 MVC SEEK1X(2),SEEKADR GET 22320020 MVC SEEK2X(2),SEEKADR CELL ADDRESS 22330020 MVC SEEK1X+5(1),SEEKADR+5 GET THE HEAD ADDRESS. 22340020 MVC SEEK2X+5(1),SEEKADR+5 GET THE HEAD ADDRESS. 22350020 XC SEEK2X+2(3),SEEK1X+2 CHANGE SUBCELL/STRIP/CYLINDER. 22360020 MVI ACTXIISW,X'10' SET SWITCH FOR DIRECT RETURN. 22370020 BAL LINK9,STARTIO SEEK TO AN OFF ADDRESS. 22380020 MVI ACTXIISW,X'00' RESET THE DIRECT RETURN SWITCH. 22390020 BAL LINK15,TENTRY RETRY TEN TIMES 22400020 BR LINK14 SOLID RETURN TO USER 22410020 SPACE 1 22420020 RESEEKM CCW 7,SEEK2X,X'40',6 SEEK DIFFERENT ADDRESS. 22430020 CCW 7,SEEK1X,X'00',6 SEEK DIFFERENT ADDRESS. 22440020 SEEK1X DC X'0000010101010000' AT LEAST ONE ADDRESS 22450020 SEEK2X DC X'000003030303' DIFFERENT THAN ORIGINAL 22460020 SPACE 1 22470020 ACTXI TM 25(UCBREG),X'01' OVERFLOW INCPMPLETE ALSO 22480020 BZ ACTXIA NO - CHECK FURTHER 22490020 BAL LINK14,TENSEEK RESTORE, RETRY 10 TIMES 22500020 B SEEKCHK SOLID - SEEK CHECK ROUTINE 22510020 ACTXIA TM 24(UCBREG),X'80' COMMAND REJECT ALSO 22520020 BO SEEKCHK YES - SOLID 22530020 BAL LINK14,ACTX 22540020 B SEEKCHK SOLID 22550020 EJECT 22560020 ACTXII TM ACTXIISW,X'20' EXICUTE ORIG CCW LIST RETURN 22570020 BO TWOTRY RETURN TO TWOTRY ROUTINE. 22580020 CLC UCBTO+17(3),ADERASE DATA CHECK DURING ERASE TIME. 22590020 BNH ACTXIID NO-- 22600020 MVI ERASESW,X'FF' YES-TURN ON ERASE SWITCH. 22610020 ACTXIID MVI ACTXIISW,X'21' TURN ON FIRST ENTRY(01)ORIG(20). 22620020 L REGD,ERRSAV1+12 GET CAW 22630020 L REGD,0(REGD) GET HALF OF SEEK CCW 22640020 ST REGD,SORIG SAVE FOR SEEK ORIGINAL TRACK 22650020 MVC HIADR(4),0(REGD) ADDRESS FOR SEEK HIGHEST 22660020 L REGE,HIADR IN REGISTER TO MODIFY STRIP 22670020 ST REGE,LOWADR SAVE FOR SEEK FIRST TRACK 22680020 A REGE,F1 PREPARE FOR NEXT HIGHER STRIP 22690020 CLC UCBTO+17(3),AMFRAHA DATA CHECK DURING ANALYSIS/2321? 22700020 BL ACTXIIB NO--DO NOT REWRITE. 22710020 MVI MFWANLX+4,X'60' YES-REWRITE//REREAD. 22720020 LA GR7,MFWANAL SET TO ALLOW WRITE 22730020 ST GR7,4(UCBREG) THEN READ 22740020 ACTXIIB CLI HIADR+3,X'00' IS THIS STRIP ZERO 22750020 BE ACTXIIA YES, USE NEXT HIGHER 22760020 BCTR REGE,0 NO, GET 22770020 BCTR REGE,0 NEXT LOWER STRIP 22780020 ACTXIIA ST REGE,NXTLOW SAVE FOR SEEK NEXT LOWER 22790020 BAL LINK15,TWOTRY RETRY ORIGINAL CCWS ONCE. 22800020 LA REGE,15 15 PASSES THRU LOOP2X. 22810020 LA REGF,1 1 PASS THRU LOOP2X AND LOOP3X. 22820020 SPACE 1 22830020 LOOP2X BAL LINK15,EIGHTTRY SEEK TO HIGH-LOW TRACKS 8 TIMES. 22840020 NI ACTXIISW,X'EF' TURN OFF DIRECT RETURN BIT. 22850020 BAL LINK15,TWOTRY RETRY ORIGINAL CCWS ONCE. 22860020 BCT REGE,LOOP2X REPEAT SEQUENCE IF NECESSARY. 22870020 LA REGE,15 RESET THE LOOP COUNTER. 22880020 SPACE 1 22890020 LOOP3X LA GR3,SNXTLOW SEEK COMMAND FOR NEXT LOWER. 22900020 BAL LINK9,STARTIO OR STRIP ONE. 22910020 BAL LINK15,TWOTRY RETRY ORIGINAL CCWS ONCE. 22920020 BCT REGF,LOOP2X REPEAT SEQUENCE IF NECESSARY. 22930020 XI ACTXIISW,X'01' RESET THE FIRST ENTRY SWITCH. 22940020 TM ACTXIISW,X'01' FIRST PASS THRU BOTH LOOPS. 22950020 BO SDACTXII NO--DONE--SOLID ERROR. 22960020 LA REGE,15 15 PASSES THRU LOOP2X. 22970020 LA REGF,6 6 PASSES OF LOOP2X AND LOOP3X. 22980020 B LOOP2X REPEAT UNTIL NO ERROR OR 113. 22990020 SPACE 1 23000020 EJECT 23010020 SDACTXII MVI ACTXIISW,X'00' TURN OFF SWITCHES 23020020 MVI MFWANLX+4,X'20' RESET WRITE CCW 23030020 MVI ERRETRY,X'00' INSURE ERROR SWITCH IS OFF. 23040020 BR LINK14 SOLID ERROR - RETURN 23050020 SPACE 2 23060020 EIGHTTRY LA REGG,8 SET FOR EIGHT HI-LOW SWEEPS. 23070020 LA CCWREG,HILOWCCW GET CCW LIST-FIRST-LAST TRACKS 23080020 LOOP4X BAL LINK9,STARTIO 23090020 BCT REGG,LOOP4X DONE TRYING 23100020 BR LINK15 YES, GO ON 23110020 SPACE 2 23120020 HILOWCCW CCW 7,HIADR,X'40',6 SEEK LAST TRACK OF STRIP 23130020 CCW 7,LOWADR,X'00',6 SEEK FIRST TRACK OF STRIP 23140020 SPACE 1 23150020 SNXTLOW CCW 7,NXTLOW,X'40',6 SEEK NEXT LOWER STRIP 23160020 SORIG CCW 7,SEEKADR,X'00',6 SEEK ORIGINAL STRIP 23170020 SPACE 2 23180020 HIADR DC X'0000000004130000' LAST TRACK OF STRIP 23190020 LOWADR DC X'0000000000000000' FIRST TRACK OF STRIP 23200020 NXTLOW DC X'000000000000' NEXT STRIP LOWER 23210020 AMFRAHA DC AL3(MFRAHA) 23220020 ADERASE DC AL3(MFERASE) ADDRESS OF 2321 ERASE CCWS. 23230020 SPACE 2 23240020 * DETERMINE IF HA-R0 AREA IS DEFECTIVE HERE..2302,2311,2314,2321. 23250020 SPACE 2 23260020 ALTE906 L REGD,UCBTO+16 ADDRESS IN CSW. 23270020 S REGD,EIGHT ADDRESS OF FAILING CCW. 23280020 CLI 0(REGD),X'1A' IS THIS A READ HA CCW. 23290020 BE ALTE2311 YES-GO CHECK DEVICE TYPES. 23300020 TM FLGDRUM,H04 IS IT A 2305 S20201 23310020 BZ ALTE907 NO, TEST ERROR S20201 23320020 OI FLGDRUM,H08 2305, TURN ALT-BIT ON S20201 23330020 ALTE907 CLI L0(REGD),H16 IS THIS A READ R0 CCW S20201 23340020 BNE GETALT3 NO--GO ASSIGN AN ALTERNATE TRACK 23350020 CLI UCBTO,T2321 IS THIS A 2321 DEVICE S20201 23360020 BE ALTE2314 YES-ATTEMPT TO MOVE IN 800 BYTES 23370020 LH CSR1,TOTLCNTX TRACK CAPACITY THIS DEVICE. 23380020 S CSR1,SIXTEEN LESS AMOUNT FOR NORMAL R0. 23390020 CH CSR1,UCBTO+22 ERROR IN NORMAL R0 AREA. 23400020 BNL GETALT3 NO--GO ASSIGN AN ALTERNATE TRACK 23410020 SPACE 1 23420020 ALTE2311 CLI UCBTO,T2314 THIS A 2314 S20201 23430020 BE ALTE2314 YES, PROCESS BAD TRACK S20201 23440020 CLI UCBTO,T2321 THIS A 2321 S20201 23450020 BNE TRACKBAD MUST BE 2302 OR 2311 S20201 23460020 ALTE2314 MVC PRWD(28),HAROMSG BAD HA-R0 MESSAGE. 23470020 MVI PRWD+6,C'I' INDICATE INFORMATION MESSAGE. 23480020 LA CSR1,28 COUNT OF MESSAGE 23490020 BAL LINK9,PRNT 23500020 XI ERR906SW,X'01' FIST ATTEMPT TO 23510020 TM ERR906SW,X'01' ASSIGN ALTERNATE 23520020 BO GETALT3 YES, TRY 23530020 BAL LINK15,TRKPRNT1 NO, PRINT TRACK ADDRESS 23540020 B DATACHK TERMINATE 23550020 EJECT 23560020 * ************************************************** 23570020 * * ROUTINES BELOW ARE COMMON TO DASD DEVICES * 23580020 * ************************************************** 23590020 SPACE 1 23600020 * SEEKED TO CORRECT CYLINDER ROUTINE 23610020 SPACE 1 23620020 CYLNCHK L GR7,4(UCBREG) GET SEEK CCW LIST ADDR. FROM CSW 23630020 L GR3,L0(GR7) GET ADDR OF BBCCHH S20201 23640020 MVC STORSEEK(L4),L2(GR3) SAVE SEEK ADDRESS S20201 23650020 LA GR3,READHOME GET ADDR. OF READ HOME ADDR. CCW 23660020 BAL LINK9,STARTIO DO READ HOME ADDRESS OPERATION. 23670020 CLC HOMEBUF+1(4),STORSEEK VERIFY SEEK TO PROPER CYLN. NUMB 23680020 BCR 7,LINK15 INCORRECT CYLINDER-RESEEK HEADS 23690020 BC 8,4(LINK15) CORRECT CYLINDER- ERROR RETURN 23700020 SPACE 1 23710020 STORSEEK DC 3H'0' SAVE AREA FOR SEEK TO CCHH FLD. 23720020 SPACE 1 23730020 DS 0D DOUBLE WORD BOUNDARY 23740020 READHOME DC X'1A' READ HOME ADDRESS OP. CODE 23750020 DC AL3(HOMEBUF) ADDRESS OF READIN BUFFER 23760020 DC X'20000005' COUNT OF 5/////SILI BIT ON///// 23770020 SPACE 1 23780020 HOMEBUF DC XL5'00' BUFFER FOR READ H/A FIVE BYTES 23790020 SPACE 1 23800020 * TEN RESEEK/RETRY ROUTINE 23810020 T3SEEK LA GR3,WIPEHEAD ADDRESS OF RESTORE CCW. 23820020 CLI L0(UCBREG),T2302 IS THIS FOR 2302 S20201 23830020 BNE TWOSEEK1 NO 23840020 LA GR3,SEEK2302 YES - SEEK SYLINDER 251 23850020 MVI ACTXIISW,X'10' SET FOR DIRECT RETURN. 23860020 BAL LINK9,STARTIO SEEK CE CYLINDER. 23870020 MVI ACTXIISW,X'00' RESET DIRECT REURN SWITCH. 23880020 LA GR3,SEEKZERO SEEK TO ZERO CCW. 23890020 TWOSEEK1 BAL LINK9,STARTIO PERFORM SEEK CCW LIST. 23900020 BAL LINK15,T3TRY RETRY ERROR CCW LIST 3 TIMES. 23910020 BR LINK14 SOLID ERROR//..//RETURN//.... 23920020 SPACE 1 23930020 TENSEEK LA GR3,WIPEHEAD ADDRESS OF HEAD CLEAN CCW LIST 23940020 CLI L0(UCBREG),T2302 IS THIS FOR 2302 S20201 23950020 BNE TENSEEK1 NO 23960020 LA GR3,SEEK2302 YES; SEEK CYLINDER 251 23970020 MVI ACTXIISW,X'10' SET FOR DIRECT RETURN. 23980020 BAL LINK9,STARTIO SEEK CE CYLINDER. 23990020 MVI ACTXIISW,X'00' RESET DIRECT REURN SWITCH. 24000020 LA GR3,SEEKZERO SEEK TO ZERO CCW. 24010020 TENSEEK1 BAL LINK9,STARTIO PERFORM SEEK CCW LIST. 24020020 BAL LINK15,TENTRY RETRY ERROR CCW LIST 10 TIMES 24030020 BR LINK14 SOLID ERROR//---//RETURN//--- 24040020 SPACE 1 24050020 DS 0D 24060020 WIPEHEAD CCW X'13',0,X'60',1 RESTORE COMMAND 2311 24070020 CCW X'17',0,X'20',1 2321 24080020 SPACE 1 24090020 SEEK2302 CCW 7,SEEK251,X'00',6 SEEK CYLINDER 251. 24100020 SEEKZERO CCW 7,CLEAR,X'00',6 SEEK CYLINDER 0. 24110020 SPACE 1 24120020 SEEK251 DC X'000000FB0000' SEEK TO CYL 251 BBCCHH FIELD 24130020 SPACE 1 24140020 * TRACK OVERRUN ERROR ROUTINE 24150020 SPACE 1 24160020 TROVRRUN LA ERREG1,EMES14 INDEX TO MESSAGE TABLE. 24170020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 24180020 EJECT 24190020 SPACE 1 24200020 * SURFACE ANALYSIS ERROR ENTRY COUNTER ROUTINE 24210020 SPACE 1 24220020 SURCHECK TM ENTRYTWO,X'0E' IS 2ND ERROR ENTRY SWITCH ON 24230020 BC 1,BADSURF YES-GO TO BAD SURFACE EXIT. 24240020 MVI ENTRYTWO,X'0E' SET SWITCH FOR 2ND ENTRY ERROR. 24250020 LM 0,15,ERRSAV1 RESTORE REGISTERS FOR LINK9 RTN. 24260020 ST IOLOOP,ERRPASS SAVE THE PASS COUNT. 24270020 LA IOLOOP,10 NO SET LOOP COUNTER TO TEN 24280020 LA CCWREG,ERRSEEK CCW LIST FOR PROCESSING ERROR. 24290020 TENERR BAL LINK9,STARTIO READ VERIFY HA/R0. 24300020 BCT IOLOOP,TENERR REPEAT 10 TIMES IF NO ERROR. 24310020 LA CCWREG,WRTALT NO ERROR//MUST FORMAT TRACK. 24320020 BAL LINK9,STARTIO WRITE STANDARD HA-R0. 24330020 MVI ENTRYTWO,X'00' RESET ERROR SWITCH. 24340020 L IOLOOP,ERRPASS PICK UP THE PASS COUNT. 24350020 B TESTCNT RETRN TO ANALYSIS ROUTINE. 24360020 SPACE 1 24370020 BADSURF MVI ENTRYTWO,X'00' RESET ENTRY CTR. FOR BAD EXIT. 24380020 LA LINK15,ORGBAD1 RETURN FOR DRUM S20201 24390020 TM FLGDRUM,H0B DRUM OR 2305 W/O ALT S20201 24400020 BO TRKPRNT1 YES, DO NOT ASSGN ALT S20201 24410021 B ALTE906 GO DETERMINE FIELD IN ERROR. 24420020 SPACE 1 24430020 * TRACK CHECK ERROR ROUTINE 24440020 SPACE 1 24450020 TRACKCHK LA GR3,SEEKIPLX CCW LIST TO GET POINTER TO ALT 24460020 MVI ERRETRY,X'FF' SWITCH - DO NOT DESTERB REGISTER 24470020 CLI DSCBSW,X'01' ARE DSCBS BEING WRITTEN. 24480020 BNE TRACK1 NO--GO GET POINTER TO ALTERNATE. 24490020 LA GR3,SEEKIPL1 YEX-SEEK TO PROPER TRACK. 24500020 TRACK1 B STARTIO READ HA AND R0 24510020 R0EOF LM 0,15,ERRSAV1 RESTORE THE REGISTERS. 24520020 CLI ERRETRY,X'FF' TRACK CONDITION CHECK PRIOR. 24530020 BCR 7,LINK9 NO--TAKE NORMAL STARTIO RETURN. 24540020 MVI ERRETRY,X'00' YES-TURN OFF THE ERROR SWITCH. 24550020 CLI NORCDSW,X'F0' WERE WE LOOKING FOR VOLUME LABEL 24560020 BC 7,TRCK2 NO--CHECK ADDITIONAL. 24570020 MVC SEEKVOL+1(3),ALTCCWX+1 MODIFY SEEK CCW FOR ALTERNATE. 24580020 B RETALT GO READ LABEL ON ALTERNATE. 24590020 TRCK2 LA GR3,ALTCCWX CCW LIST TO SEEK TO ALTERNATE. 24600020 CLI DSCBSW,X'01' ARE DSCBS BEING WRITTEN. 24610020 BC 8,STARTIO YES-GO WRITE DSCBS ON ALTERNATE. 24620020 TM XXXR0+L7,H08 WAS EOF JUST WRITTEN S20201 24630020 BNO NTALFALT NO S20201 24640020 BR LINK9 TAKE NORMAL SIO EXIT S20201 24650020 NTALFALT MVC WRTZERTR+K1(K3),ALTCCWX+K1 NO SEEK FOR TRK 0 S20201 24660020 LA GR3,WRTZERTR CCW LIST TO WRITR 0 ON ALTERNATE 24670020 B STARTIO WRITE TRACK 0 ON ALTERNATE. 24680020 SPACE 1 24690020 * DASD OVERFLOW ERROR ROUTINE 24700020 SPACE 1 24710020 OVRFLOW LA ERREG1,EMES23 INDEX TO MESSAGE TABLE 24720020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 24730020 SPACE 1 24740020 * FILE PROTECTED ERROR ROUTINE 24750020 SPACE 1 24760020 FILEPROT LA ERREG1,EMES15 INDEX TO MESSAGE TABLE. 24770020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 24780020 SPACE 1 24790020 * INVALID ADDRESS ERROR ROUTINE 24800020 SPACE 1 24810020 INVLDADR LA ERREG1,EMES10 INDEX TO MESSAGE TABLE 24820020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 24830020 SPACE 1 24840020 * SEEK CHECK ROUTINE 24850020 SPACE 1 24860020 SEEKCHK LA ERREG1,EMES30 INDEX TO MESSAGE TABLE 24870020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 24880020 SPACE 1 24890020 * NO RECORD FOUND ERROR ROUTINE 24900020 SPACE 1 24910020 NORECFND CLI NORCDSW,X'F0' IS THIS A LABEL CHECK ERROR RTN. 24920020 BC 7,NORECMSG NO-GO TO PRINT ERROR MSG RTN. 24930020 LM 0,15,ERRSAV1 YES-RESTORE REGISTERS FOR RETURN 24940020 B RCDRTN GO TO NO LABEL FOUND ROUTINE. 24950020 SPACE 1 24960020 NORECMSG LA ERREG1,EMES17 NO, GET INDEX TO MESSAGE TABLE. 24970020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 24980020 SPACE 1 24990020 * END OF CYLINDER ERROR ROUTINE 25000020 SPACE 1 25010020 ENDOFCYL LA ERREG1,EMES09 INDEX TO MESSAGE TABLE 25020020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 25030020 SPACE 1 25040020 * MISSING ADDRESS MARKER ERROR ROUTINE. 25050020 SPACE 1 25060020 MISSMARK LA ERREG1,EMES34 INDEX TO MESSAGE TABLE. 25070020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 25080020 * INVALID TRACK FORMAT ERROR 25090020 INTRKFMT LA ERREG1,EMES40 INDEX TO MSG TABLE S20201 25100020 B ERROROUT PRINT ERROR MSG S20201 25110020 SPACE 1 25120020 BLNKSTOP STC GR15,ACTXIISW PREPARE TO ACCESS ADDRESS 25130020 NI ACTXIISW,X'03' CLEAR HIGH ORDER BITS. 25140020 LA ERREG1,EMES35 SET UP FOR BLANK TRACKS 25150020 TM ACTXIISW,X'03' BLANK TRACKS? 25160020 BO ERROROUT YES 25170020 LA ERREG1,EMES38 BLANK SUB CELLS? 25180020 BZ ERROROUT YES 25190020 LA ERREG1,EMES36 SET UP FOR BLANK CYLINDERS 25200020 TM ACTXIISW,X'01' BLANK CYLINDERS? 25210020 BZ ERROROUT YES 25220020 LA ERREG1,EMES37 NO - 25230020 B ERROROUT THEN BLANK STRIPS 25240020 EJECT 25250020 * ************************************************** 25260020 * * ROUTINES BELOW ARE COMMON TO TAPE DEVICES * 25270020 * ************************************************** 25280020 SPACE 2 25290020 * TEST TAPE DATA CHECK==READ OR WRITE? 25300020 SPACE 1 25310020 TAPEDATA TM 25(UCBREG),X'04' TAPE IN READ OR WRITE STATUS? 25320020 BC 14,NOISETST READ STATUS-PERFORM NOISE CHECK 25330020 BC 1,RITERROR WRITE STATUS-GO TO WRITE ERROR 25340020 SPACE 1 25350020 * TAPE DATA CHECK ON WRITE ROUTINE 25360020 SPACE 1 25370020 RITERROR BAL LINK15,BACKSPC BACKSPACE TAPE ONE RECORD 25380020 BAL LINK15,ERASE ERASE ONE LONG GAP ON TAPE 25390020 BAL LINK15,TRETRY RETRY ERROR CCW LIST THREE TIMES 25400020 LA ERREG1,EMES31 INDEX TO MESSAGE TABLE 25410020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 25420020 SPACE 1 25430020 * TAPE BACKSPACE ROUTINE 25440020 SPACE 1 25450020 BACKSPC LA GR3,BSPACE GET ADDRESS OF BACKSPACE CCW 25460020 BAL LINK9,STARTIO PERFORM BACKSPACE OPERATION. 25470020 BCR 15,LINK15 RETURN TO CALLING ROUTINE 25480020 SPACE 1 25490020 DS 0D DOUBLE WORD BOUNDARY 25500020 BSPACE DC X'27' OP CODE FOR BACKSPACE 25510020 DC X'00000020000001' REMAINDER OF CCW 25520020 SPACE 1 25530020 * TAPE ERASE ONE LONG GAP ROUTINE 25540020 SPACE 1 25550020 ERASE LA GR3,ERASEGAP GET ADDRESS OF ERASE CCW LIST. 25560020 BAL LINK9,STARTIO PERFORM ERASE OPERATION. 25570020 BR LINK15 RETURN TO CALLING ROUTINE 25580020 SPACE 1 25590020 DS 0D 25600020 ERASEGAP DC X'17' OP CODE FOR ERASE 25610020 DC X'00000020000001' REMAINDER OF CCW 25620020 SPACE 1 25630020 * TAPE AT LOAD POINT ROUTINE 25640020 SPACE 1 25650020 TAPELP TM LPSWITCH,X'EE' LP OCCURED DURING TAPECLN RTN. 25660020 BC 1,LPDATA YES--GO TO DATA CHECK AT LP EXIT 25670020 LA ERREG1,EMES32 NO- INDEX TO THE MESSAGE TABLE 25680020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 25690020 SPACE 1 25700020 LPSWITCH DC X'00' SWITCH AT 'EE'//DATA CHECK AT LP 25710020 EJECT 25720020 * TAPE READ DATA CHECK////NOISE RECORD ERROR ROUTINE. 25730020 SPACE 1 25740020 NOISETST L GR7,16(UCBREG) LOAD ADDRESS OF NEXT CCW AFTER 25750020 S GR7,EIGHT GET ADDRESS OF ERROR CCW 25760020 MVC TIECCW1(8),0(GR7) LOAD ERROR CCW IN TIE CCW LIST 25770020 LH GR3,K6(GR7) LOAD COUNT OF ERROR CCW S20201 25780020 SH GR3,K22(UCBREG) GET NUMBER OF BYTES READ S20201 25790020 CH GR3,TWELVE TEST FOR TWELVE BYTES S20201 25800020 BC 10,READTAPE 12 BYTES OR MORE RECORD LENGTH 25810020 TM 25(UCBREG),X'80' LESS THAN 12BYTE-CHECK NOISE BIT 25820020 BC 8,NOISEREC NOISE BIT OFF-GO TO NOISEREC RTN 25830020 BC 7,READTAPE NOISE BIT-GO TO READTAPE RTN. 25840020 SPACE 1 25850020 NOISEREC LM 0,15,ERRSAV1 RESTORE REGISTERS FOR RETURN. 25860020 B STARTIO IGNORE NOISE REC.--GET NEXT RECD 25870020 SPACE 1 25880020 READTAPE BAL LINK15,BACKSPC BACKSPACE TAPE ONE RECORD 25890020 L GR7,READTEN SETUP COUNTER FOR READ RETRYS 25900020 BCT GR7,READLOOP PERFORM 10 RETRYS IF ERROR CONTS 25910020 TM 25(UCBREG),X'08' IS THE TAPE AT LOAD POINT. 25920020 BC 1,NOCLEAN YES--BYPASS TAPE CLEANER ROUTINE 25930020 MVI LPSWITCH,X'EE' SET LP SW ON TO DETECT BS TO LP. 25940020 BAL LINK15,TAPECLN LINK TO TAPE CLEANER ROUTINE 25950020 MVI LPSWITCH,X'00' RESET LP SWITCH TO OFF. 25960020 SPACE 1 25970020 NOCLEAN L GR3,CLEANCTR SETUP TAPE CLEANER S20201 25980020 BCT GR3,CLEANLOP ALLOW 10 RETRIES S20201 25990020 SPACE 1 26000020 LPDATA MVC READTEN(4),READSET SOLID ERROR//RESET COUNTER TO 10 26010020 MVC CLEANCTR(4),CLEANSET 10TH ENTRY TO TAPE CLEANER/RESET 26020020 MVI LPSWITCH,X'00' RESET LOAD POINT SWITCH OFF. 26030020 LA ERREG1,EMES12 INDEX TO MESSAGE TABLE 26040020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 26050020 SPACE 1 26060020 CLEANLOP ST GR3,CLEANCTR SAVE NEW CTR VALUE S20201 26070020 L GR7,READSET 10TH READ RETRY--RESET READTEN. 26080020 SPACE 1 26090020 READLOOP ST GR7,READTEN SAVE DECREMENTED COUNTER VALUE 26100020 MVC TIEBYTE(1),26(UCBREG) PUT SENSE BYTE 2 IN TIE CCW LIST 26110020 MVI ERRETRY,X'FF' TURN ERROR RETRY SWITCH ON. 26120020 LA GR3,TIECCW LOAD TRACK IN ERROR CCW LIST ADR 26130020 BAL LINK9,STARTIO EXECUTE T.I.E. CCW LIST. 26140020 MVC READTEN(4),READSET NO ERROR RETURN--RESET COUNTER. 26150020 MVC CLEANCTR(4),CLEANSET NO ERROR RETURN--RESET COUNTER. 26160020 B ERRPSD TURN OFF SWITCHES AND RETURN 26170020 SPACE 2 26180020 DS 0F 26190020 READTEN DC X'0000000A' COUNT OF RETRYS 26200020 READSET DC X'0000000A' RESTORE VALUE 26210020 CLEANCTR DC X'0000000A' COUNT OF TAPE CLEANER ENTRYS 26220020 CLEANSET DC X'0000000A' RESTORE VALUE 26230020 SPACE 1 26240020 DS 0D 26250020 TIECCW DC X'1B' TRACK IN ERROR COMMAND CODE. 26260020 DC AL3(TIEBYTE) ADDRESS OF TRACK IN ERROR BYTE 26270020 DC X'60000001' CHAIN BIT ON//SLI BIT ON// 26280020 TIECCW1 DC X'0000000000000000' SPACE FOR INSERTING READ CCW . 26290020 SPACE 1 26300020 TIEBYTE DC X'00' SPACE TO INSERT SENSE BYTE TWO. 26310020 SPACE 1 26320020 DS 0F FULL WORD ALIGNMENT 26330020 SIXTEEN DC 1F'16' 'SIXTEEN' ON FULL WORD BOUNDRY. 26340020 EIGHT DC F'08' FULL WORD OF 08 26350020 TWELVE DC H'12' HALF WORD OF 12 26360020 SPACE 1 26370020 * TAPE CLEANER ROUTINE 26380020 SPACE 1 26390020 TAPECLN LA GR3,CLEANTP GET ADDRESS OF TAPE CLEANER CCWS 26400020 BAL LINK9,STARTIO PERFORM TAPE CLEANER ROUTINE. 26410020 BR LINK15 RETURN TO CALLING ROUTINE 26420020 SPACE 1 26430020 DS 0D 26440020 CLEANTP DC X'27' BACKSPACE OP CODE 26450020 DC X'00000060000001' CHAIN BIT ON///SLI BIT ON// 26460020 DC X'27' BACKSPACE OP CODE 26470020 DC X'00000060000001' CHAIN BIT ON///SLI BIT ON// 26480020 DC X'37' FORWARD SPACE OP CODE 26490020 DC X'00000060000001' CHAIN BIT ON///SLI BIT ON// 26500020 DC X'37' FORWARD SPACE OP CODE 26510020 DC X'00000020000001' CHAIN BIT OFF//SLI BIT ON// 26520020 EJECT 26530020 * ************************************************** 26540020 * * ROUTINES BELOW USED FOR ALL I/O ERROR RETRYS. * 26550020 * ************************************************** 26560020 SPACE 1 26570020 * TWO RETRYS OF ERROR CCW ROUTINE 26580020 SPACE 1 26590020 TWOTRY TM TWOFLAG,X'02' IS THIS SECOND ENTRY INTO TWOTRY 26600020 BC 1,BADTRY YES. GO TO PERMANENT ERROR EXIT. 26610020 MVI TWOFLAG,X'02' NO...SET TWOFLAG TO ON. 26620020 MVI ERRETRY,X'FF' TURN ERROR RETRY SWITCH ON. 26630020 L GR3,4(UCBREG) GET ADDRESS OF START OF CCW LIST 26640020 BAL LINK9,STARTIO RETRY CCW LIST ONCE MORE. 26650020 CLI UCBTO,X'04' IS IT A 2321 A43889 26657021 BE RETR2321 YES,RETRY TWICE MORE A43889 26659021 GOODTEST MVI TWOFLAG,X'00' RETRY OK - TWOFLAG OFF A43889 26665021 SPACE 1 26670020 ERRPSD MVI ERRETRY,X'00' TURN ERROR RETRY SWITCH OFF 26680020 MVI ACTXIISW,X'00' TURN OFF ACTXII SWITCH 26690020 MVC REGSV5(64),ERRSAV1 RESTORE ORIGINAL P/P REGISTERS 26700020 CLC UCBTO+17(3),AMFRAHA 2321 ERROR DURING READ OR ERASE. 26710020 BH ACTVIIIF YES-NEED TO REWRITE THIS TRACK. 26720020 B IORTRN CCW LIST EXECUTED//RETURN// 26730020 SPACE 1 26740020 BADTRY MVI TWOFLAG,X'00' PERMANENT ERROR//SET TWOFLAG OFF 26750020 BR LINK15 SOLID ERROR----//RETURN//--- 26760020 RETR2321 BAL LINK9,STARTIO RETRY 2321 CCW CHAIN A43889 26760521 BAL LINK9,STARTIO RETRY 2321 CCW CHAIN A43889 26761021 B GOODTEST SUCCESSFUL - RETURN A43889 26761521 SPACE 1 26770020 TWOFLAG DC X'00' '00' EQUAL OFF/// '02' EQUAL ON. 26780020 SPACE 1 26790020 ERRETRY DC X'00' ERROR RETRY SWITCH '00' IS OFF. 26800020 SPACE 1 26810020 * THREE ERROR RETRYS ROUTINE. 26820020 SPACE 1 26830020 TRETRY L GR7,TRECTR SETUP COUNTER FOR RETRY 26840020 BCT GR7,TRELOOP BR--ALLOW UP TO THREE RETRYS-- 26850020 MVC TRECTR(4),TRESET 3RD RETRY ERROR--RESET COUNTER 26860020 BR LINK15 SOLID ERROR----//RETURN//---- 26870020 SPACE 1 26880020 TRELOOP ST GR7,TRECTR SAVE DECREMENTED COUNTER TOTAL 26890020 MVI ERRETRY,X'FF' TURN ERROR RETRY SWITCH ON. 26900020 L GR3,4(UCBREG) GET ADDRESS OF START OF CCW LIST 26910020 BAL LINK9,STARTIO RETRY CCW LIST ONCE MORE. 26920020 MVC TRECTR(4),TRESET NO ERROR RETURN-SET COUNTER TO 3 26930020 B ERRPSD TURN OFF SWITCHES AND RETURN 26940020 SPACE 1 26950020 DS 0F 26960020 TRECTR DC X'00000003' COUNT OF RETRYS. 26970020 TRESET DC X'00000003' RESTORE VALUE 26980020 EJECT 26990020 * SIX ERROR RETRYS ROUTINE 27000020 SPACE 1 27010020 SIXTRY L GR7,SIXCTR SETUP COUNTER FOR RETRY 27020020 BCT GR7,SIXLOOP BR--ALLOW UP TO FIVE RETRYS-- 27030020 MVC SIXCTR(4),SIXSET 6TH ERROR--RESET COUNTER 27040020 BR LINK15 SOLID ERROR----//RETURN//--- 27050020 SPACE 1 27060020 SIXLOOP ST GR7,SIXCTR SAVE DECREMENTED COUNTER TOTAL 27070020 MVI ERRETRY,X'FF' TURN ERROR RETRY SWITCH ON. 27080020 L GR3,4(UCBREG) GET ADDRESS OF START OF CCW LIST 27090020 BAL LINK9,STARTIO RETRY CCW LIST ONCE MORE. 27100020 MVC SIXCTR(4),SIXSET NO ERROR RETURN-SET COUNTER TO 5 27110020 B ERRPSD TURN OFF SWITCHES AND RETURN 27120020 SPACE 1 27130020 DS 0F 27140020 SIXCTR DC X'00000005' COUNT OF RETRYS 27150020 SIXSET DC X'00000005' RESTORE VALUE 27160020 SPACE 1 27170020 * TEN RETRYS OF ERROR CCW LIST ROUTINE 27180020 SPACE 1 27190020 TENTRY L GR7,TENCTR SETUP COUNTER FOR RETRY 27200020 BCT GR7,TENLOOP BR--ALLOW UP TO TEN RETRYS-- 27210020 MVC TENCTR(4),TENSET 10TH ERROR--RESET COUNTER-- 27220020 BR LINK15 SOLID ERROR----//RETURN//--- 27230020 SPACE 1 27240020 TENLOOP ST GR7,TENCTR SAVE DECREMENTED COUNTER TOTAL 27250020 MVI ERRETRY,X'FF' TURN ERROR RETRY SWITCH ON. 27260020 L GR3,4(UCBREG) GET ADDRESS OF START OF CCW LIST 27270020 BAL LINK9,STARTIO RETRY CCW LIST ONCE MORE. 27280020 MVC TENCTR(4),TENSET NO ERR. RETURN-SET COUNTER TO 10 27290020 B ERRPSD TURN OFF SWITCHES AND RETURN 27300020 SPACE 1 27310020 DS 0F 27320020 TENCTR DC X'0000000B' COUNT OF RETRIES. 27330020 TENSET DC X'0000000B' RESTORE VALUE. 27340020 SPACE 1 27350020 * THREE RETRIES OF ERROR LIST ROUTINE. 27360020 SPACE 1 27370020 T3TRY LH GR7,T3CTR SETUP COUNTER FOR RETRY. 27380020 BCT GR7,T3LOOP ALLOW UP TO 3 RETRIES. 27390020 MVC T3CTR(2),T3SET 3RD ERROR//RESET COUNTER. 27400020 BR LINK15 RETURN. 27410020 T3LOOP STH GR7,T3CTR SAVE NEW COUNTER VALUE. 27420020 MVI ERRETRY,X'FF' INDICATE ERROR PROCESSING. 27430020 L GR3,4(UCBREG) ERROR CCW LIST. 27440020 BAL LINK9,STARTIO REPEAT THE FAILING OPERATION. 27450020 MVC T3CTR(2),T3SET RESET COUNTER//NO ERROR. 27460020 B ERRPSD ERROR RECOVERY RETURN. 27470020 SPACE 1 27480020 T3CTR DC H'4' COUNT OF RETRIES. 27490020 T3SET DC H'4' RESTORE VALUE. 27500020 SPACE 1 27510020 * SIXTEEN BY SIXTEEN ERROR RETRY ROUTINE. 27520020 SPACE 1 27530020 SIXTTRY LH GR7,RECALCTR PICK UP COUNTER VALUE. 27540020 BCT GR7,SIXTLOOP RECALIBRATE AFTER 16 ENTRIES. 27550020 LA GR3,WIPEHEAD RECALIBRATE CCW. 27560020 CLI L0(UCBREG),T2302 IS THIS A 2302 S20201 27570020 BNE SIXTEENS NO--GO PERFORM RECALIBRATE. 27580020 LA GR3,SEEKZERO YES-SET UP FOR SEEK TO ZERO. 27590020 SIXTEENS BAL LINK9,STARTIO POSITION DEVICE TO ZERO. 27600020 LA GR7,17 VALUE TO RESET COUNTER. 27610020 SIXTLOOP STH GR7,RECALCTR STORE NEW COUNTER VALUE. 27620020 LH GR7,CTR16 PICK UP RETRY VALUE. 27630020 BCT GR7,S16LOOP HAVE WE RETRIED 256 TIMES. 27640020 MVC CTR16(4),RESET YES-SOLID ERROR/RESET COUNTERS. 27650020 BR LINK15 RETURN TO CALLER. 27660020 S16LOOP STH GR7,CTR16 STORE NEW COUNTER VALUE. 27670020 L GR3,4(UCBREG) CCW LIST IN ERROR. 27680020 MVI ERRETRY,X'FF' INDICATE RETRYING ERROR. 27690020 BAL LINK9,STARTIO RETRY CCW LIST ONCE MORE. 27700020 MVC CTR16(4),RESET NO ERROR//RESET COUNTERS. 27710020 B ERRPSD TAKE ERROR RECOVERY RETURN. 27720020 CTR16 DC H'257' COUNT OF RETRIES. 27730020 RECALCTR DC H'17' RECALIBRATE COUNT. 27740020 RESET DC H'257' RESTORE VALUE. 27750020 DC H'17' RESTORE VALUE. 27760020 EJECT 27770020 * ***************************************************** 27780020 * * ROUTINES BELOW USED FOR OPERATOR ALERT ROUTINES. * 27790020 * ***************************************************** 27800020 SPACE 2 27810020 * TYPE OPERATOR MESSAGE//WAIT ROUTINE 27820020 SPACE 1 27830020 DEVWAIT LA GR1,50 LENGTH OF MESSAGE IN BYTES. 27840020 LA GR2,READYDEV ADDRESS OF READYDEV MESSAGE. 27850020 SPACE 1 27860020 TYPEWAIT BAL LINK15,OPPRNT LINK TO I/O WRITER PRINT MESSAGE 27870020 SPACE 1 27880020 WAITTRY LA GR7,STARTIO SET UP TO MODIFY CONTINUE PSW. 27890020 ST GR7,CONTINUE+4 MODIFY CONTINUE REENTRY POINT 27900020 LM 0,15,ERRSAV1 RESTORE REGS TO RETRY ORIG. CCW. 27910020 LPSW IOWAIT REENTER STARTIOX ON READY DEVICE 27920020 SPACE 2 27930020 READYRDR DC C'IBC154A READY READER . ' 27940020 READCHK DC C'IBC159A READER CHECK. CORRECT ERROR. DEPRESS ' 27950020 SPACE 1 27960020 DC C'INTERRUPT KEY.' 27970020 SPACE 1 27980020 READYPRT DC C'IBC155A READY PRINTER .' 27990020 SPACE 1 28000020 PRINTCHK DC C'IBC160A PRINT CHECK. CORRECT ERROR. DEPRESS ' 28010020 DC C'INTERRUPT KEY.' 28020020 SPACE 1 28030020 INVALCRD DC C'IBC101W INVALID CARD CODE. CORRECT ERROR. ' 28040020 DC C'DEPRESS INTERRUPT KEY.' 28050020 SPACE 1 28060020 TYPEFAIL DC C'IBC153A TYPEWRITER FAILED TO READ LAST MESSAGE. ' 28070020 DC C' DEPRESS INTERRUPT KEY.' 28080020 SPACE 1 28090020 READYDEV DC C' DEPRESS INTERRUPT KEY.' 28100020 SPACE 1 28110020 DISKMSG DC C'IBC157A READY DASD . ' 28120020 SPACE 1 28130020 TAPEMSG DC C'IBC156A READY TAPE . ' 28140020 GETCELL DC C'IBC167A SEEKED BALLAST CELL. MOUNT PROPER CELL.' 28150020 DC C' DEPRESS INTERRUPT KEY.' 28160020 EJECT 28170020 * CONVERT UNIT INTERFACE ADDRESS TO EBDIC FOR PRINTING. 28180020 SPACE 2 28190020 UNITADDR UNPK UNITBUF(5),2(3,GR7) UNPACK CHANNEL AND UNIT ADDRESS. 28200020 TR UNITBUF(4),IOTAB-240 TRANSULATE TO BCD. 28210020 BR LINK15 RETURN TO USER. 28220020 SPACE 2 28230020 UNITBUF DS 1D BUFFER FOR EBDIC UNIT ADDRESS. 28240020 SPACE 2 28250020 EJECT 28260020 * ************************************************** 28270020 * * ROUTINES BELOW ARE COMMON TO ALL I/O DEVICES * 28280020 * ************************************************** 28290020 SPACE 2 28300020 * PRINT ERROR MESSAGE AND TERMINATE ROUTINE. 28310020 SPACE 1 28320020 ERROR0F MVI 115,X'0F' INDICATE I/O CHANNEL FAILURE 28330020 B SEREPEND GO TO ERROR END TERMINATE. 28340020 SPACE 1 28350020 ERROROUT MVI 115,X'1F' INDICATE IO DEVICE FAILURE 28360020 SPACE 1 28370020 SEREPEND MVC 58(2),2(UCBREG) PUT CHANNEL AND UNIT IN I/O PSW 28380020 MVC SEREPSAV(28),48 SAV OLD MC,IO PSW,CSW,CAW 28390020 MVC 24(6),24(UCBREG) SAVE SENSE BYTES FOR SEREP 28400020 SPACE 1 28410020 BAL LINK9,IOPRNT 28420020 LA GR1,36 LENGTH OF MESSAGE IN BYTES. 28430020 MVC PRWD(36),ENDMESS ADDRESS OF I/O ERROR END MESSAGE 28440020 BAL LINK9,PRNT PRINT I/O ERROR TERMINATE. 28450020 SPACE 1 28460020 MVC 48(28),SEREPSAV RESTORE OLD MC,I/O PSW//CSW/CAW 28470020 LM 0,15,ERRSAV1 RESTORE REGISTERS FOR SEREP 28480020 LPSW COWAIT SOLID ERROR TERMINATE. 28490020 SPACE 1 28500020 ENDMESS DC C'IBC249W I/O ERROR. JOB TERMINATED.' 28510020 SPACE 1 28520020 * START I/O ERROR ROUTINE 28530020 SPACE 1 28540020 SIOERR LA ERREG1,EMES11 INDEX TO MESSAGE TABLE 28550020 MVI 115,X'3F' INDICATE DEVICE NOT OPERATIONSL 28560020 MVI UCBSYO,X'00' FORCE MESSAGE TO CONSOLE. 28570020 B SEREPEND GO TO ERROR END TERMINATE 28580020 SPACE 1 28590020 * CHANNEL CONTROL CHECK ROUTINE 28600020 SPACE 1 28610020 CHANERR LA ERREG1,EMES20 INDEX TO MESSAGE TABLE 28620020 B ERROR0F GO TO SEREP INTERFACE SET X'0F' 28630020 SPACE 1 28640020 * INTERFACE CONTROL CHECK ROUTINE 28650020 SPACE 1 28660020 INFCERR LA ERREG1,EMES21 INDEX TO MESSAGE TABLE 28670020 B ERROR0F GO TO SEREP INTERFACE SET X'0F' 28680020 SPACE 1 28690020 * CHANNEL DATA CHECK ROUTINE 28700020 SPACE 1 28710020 CHDATA LA ERREG1,EMES22 INDEX TO MESSAGE TABLE 28720020 B ERROR0F GO TO SEREP INTERFACE SET X'0F' 28730020 SPACE 1 28740020 * PROGRAM CHECK ROUTINE 28750020 SPACE 1 28760020 PROCHK LA ERREG1,EMES24 INDEX TO MESSAGE TABLE 28770020 B ERROR0F GO TO SEREP INTERFACE SET X'0F' 28780020 SPACE 1 28790020 * PROTECTION CHECK ROUTINE 28800020 SPACE 1 28810020 PTNCHK LA ERREG1,EMES25 INDEX TO MESSAGE TABLE 28820020 B ERROR0F GO TO SEREP INTERFACE SET X'0F' 28830020 SPACE 1 28840020 * UNIT EXCEPTION ROUTINE 28850020 SPACE 1 28860020 UNITCEPT TM EDJTSW,X'01' IS END OF TASK SW ON 28870020 BO EDJTF YES, GO TO END OF JOB 28880020 L GR7,16(UCBREG) NO, ADDRESS NEXT CCW AT INTRP 28890020 S GR7,EIGHT ADDRESS OF CCW THAT CAUSED EOF. 28900020 CLI 0(GR7),X'16' WAS INTERRUPT BY A READ RO CCW. 28910020 BC 8,R0EOF YES, RETURN TO ALT ROUTINE 28920020 CL UCBREG,INPUTR WAS THE UNIT EXCPTN ON SYSIN 0243 28930020 BE ABSEQPRT IF SO, GO PRNT CNTRL SEQ ERR 0243 28940020 UEERROR LA ERREG1,EMES26 NO, INDEX TO MESSAGE TABLE. 28950020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 28960020 EJECT 28970020 * INCORRECT LENGTH 28980020 SPACE 1 28990020 WLRERR LA ERREG1,EMES27 INDEX TO MESSAGE TABLE 29000020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 29010020 SPACE 1 29020020 * CHAINING CHECK ROUTINE 29030020 SPACE 1 29040020 CHAINCHK LA ERREG1,EMES28 INDEX TO MESSAGE TABLE 29050020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 29060020 SPACE 1 29070020 * EQUIPMENT CHECK ROUTINE 29080020 SPACE 1 29090020 EQUIPCHK LA ERREG1,EMES04 INDEX TO MESSAGE TABLE 29100020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 29110020 SPACE 1 29120020 * DATA CHECK ROUTINE 29130020 SPACE 1 29140020 DATACHK LA ERREG1,EMES05 INDEX TO MESSAGE TABLE 29150020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 29160020 SPACE 1 29170020 * COMMAND REJECT ROUTINE 29180020 SPACE 1 29190020 COMREJ LA ERREG1,EMES01 INDEX TO MESSAGE TABLE 29200020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 29210020 SPACE 1 29211020 * WRITE INHIBIT ROUTINE M4697 29212020 SPACE 1 29213020 INHIBIT LA ERREG1,EMES43 GET MESSAGE INDEX M4697 29214020 B ERROROUT PRINT MSG AND TERM M4697 29215020 SPACE 1 29216020 SPACE 1 29220020 * END OF TEST ROUTINE 29230020 SPACE 1 29240020 ENDTEST LA ERREG1,EMES18 INDEX TO MESSAGE TABLE 29250020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 29260020 SPACE 1 29270020 * SHOULD NOT OCCUR ROUTINE 29280020 SPACE 1 29290020 NEVER LA ERREG1,EMES19 INDEX TO MESSAGE TABLE 29300020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 29310020 SPACE 1 29320020 * INTERVENTION REQUIRED ROUTINE 29330020 SPACE 1 29340020 INTVREQ LA ERREG1,EMES02 INDEX TO MESSAGE TABLE 29350020 BAL LINK9,IOPRNT LINK TO PRINT MESSAGE 29360020 BR LINK15 WRITE MESSAGE EXECUTED//RETURN. 29370020 EJECT 29380020 * BUS OUT CHECK ROUTINE 29390020 SPACE 1 29400020 BUSOUT LA ERREG1,EMES03 INDEX TO MESSAGE TABLE 29410020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 29420020 SPACE 1 29430020 * OVERRUN CHECK ROUTINE 29440020 SPACE 1 29450020 OVRRUN LA ERREG1,EMES06 INDEX TO MESSAGE TABLE 29460020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 29470020 SPACE 1 29480020 * UNUSUAL COMMAND SEQUENCE ROUTINE 29490020 SPACE 1 29500020 SEQERR LA ERREG1,EMES29 INDEX TO MESSAGE TABLE 29510020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 29520020 SPACE 1 29530020 * DATA CONVERTER CHECK ROUTINE 29540020 SPACE 1 29550020 CONVTERR LA ERREG1,EMES08 INDEX TO MESSAGE TABLE 29560020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 29570020 SPACE 1 29580020 * CARRIAGE SKIP TO ONE ROUTINE 29590020 SPACE 1 29600020 SKIPTO1 LA GR3,CARSKIP ADDRESS OF CARRIAGE SKIP TO 1 CCW 29610020 BAL LINK9,STARTIO PERFORM SKIP TO ONE CCW. 29620020 MVC REGSV5(64),ERRSAV1 RESTORE ORIGINAL P/P REGISTERS. 29630020 B IORTRN CCW EXECUTED//RETURN// 29640020 SPACE 1 29650020 DS 0D 29660020 CARSKIP DC X'8B' SKIP TO 1 COMMAND CODE 29670020 DC X'00000020000001' SLI BIT ON//COUNT OF 1// 29680020 SPACE 1 29690020 * SEEKED BALLAST CELL 29700020 SPACE 1 29710020 BALLAST LA GR2,GETCELL SEEKED BALLAST MESSAGE. 29720020 LA GR1,71 MESSAGE LENGTH. 29730020 B TYPEWAIT PRINT MESSAGE//AWAIT INTERRUPT. 29740020 SPACE 1 29750020 BLKTRCK1 LA ERREG1,EMES39 INDEX TO MESSAGE TABLE. 29760020 BAL LINK9,IOPRNT GIVE BLANK TRACK MESSAGE. 29770020 BR LINK14 RETURN. 29780020 EJECT 29790020 CTOEMASK DC X'2020202020202020' 29800020 SPACE 1 29810020 ALTTT DC X'0A0B0C0D0E0FDDDDDD' TABLE TO CONVERT TO HEX 29820020 DC X'DDDDDDDDDDDD' 29830020 DC X'00010203040506070809' 29840020 SPACE 1 29850020 ALTHOLD1 DC F'0' 29860020 ALTHOLD DC F'0' 29870020 ALTCNTX DC F'0' 29880020 SPACE 2 29890020 PROCBUFF DS 0F 29900020 ALTENDX DC X'00CA0009' 2311 CCHH; LAST ALTERNATE 29910020 BMPTK1 EQU ALTENDX+2 SPECIAL LAST-TRACK S20201 29920020 CNGCYLX DC X'0000FFF7' 2311 CONVERSION TO CHANGE CYLINDERS 29930020 M1PTRK DC X'FFFF000A' 2311 CONVERSION GIVE CC-1 HH+XX 29940020 ORIGENDX DC X'00C70009' 2311 CCHH;LAST ORIGINAL 29950020 BMPTK EQU ORIGENDX+2 NUMBER OF TRACKS-1 S20201 29960020 DC H'30' 2311 TOTAL NUMBER OF ALTERNATES 29970020 DEVSIZEX DC X'00CB' 2311 NO CYL (VTOC-FORMAT4-FIELD9) 29980020 TCTABLE DC H'10' 2311 TRACKS/CYLINDER 29990020 TOTLCNTX DC X'0E29' 2311 TRACK CAPACITY 30000020 DC X'523714' 2311 RECORD OVERHEAD 30010020 VTOCFLG DC X'01' 2311 FLAG 30020020 DC X'0219' 2311 TOLERANCE 30030020 DSCBPRTK DC X'10' 2311 DSCBS/TRACK 30040020 DC X'0A' 2311 DIR BLKS/TRACK 30050020 SPACE 1 30060020 * CONTROL FOR 2311 30070020 SPACE 1 30080020 DC X'00CA0009' 2311 CCHH LAST ALTERNATE 30090020 DC X'0000FFF7' 2311 CONVERSION TO CHANGE CYLINDERS 30100020 DC X'FFFF000A' 2311 CONVERSION GIVE CC-1 HH+XX 30110020 DC X'00C70009' 2311 CCHH LAST ORIGINAL 30120020 DC H'30' 2311 TOTAL NUMBER OF ALTERNATES 30130020 DC X'00CB' 2311 NO CYL (VTOC-FORMAT4-FIELD9) 30140020 DC H'10' 2311 TRACKS/CYLINDER 30150020 DC X'0E29' 2311 TRACK CAPACITY 30160020 DC X'511414' 2311 RECORD OVERHEAD 30170020 DC X'01' 2311 FLAG 30180020 DC X'0219' 2311 TOLERANCE 30190020 DC X'10' 2311 DSCBS/TRACK 30200020 DC X'0A' 2311 DIR BLKS/TRACK 30210020 SPACE 1 30220020 * CONTROL FOR 2302 30230020 SPACE 1 30240020 DC X'00F9002D' 2302 CCHH; LAST ALTERNATE 30250020 DC X'0000FFD3' 2302 CONVERSION CHANGE CYLINDERS 30260020 DC X'FFFF002E' 2302 CONVERSION GIVE CC-1 HH+46 30270020 DC X'00F5002D' 2302 CCHH; LAST ORIGINAL 30280020 DC H'184' 2302 NUMBER ALTERNATES 30290020 DC X'00FA' 2302 VTOC-FORMAT4-FIELD9 (NO CYL) 30300020 DC H'46' 2302 NO TRKS/CYL 30310020 DC X'1378' 2302 TRACK CAPACITY 30320020 DC X'511414' 2302 RECORD OVERHEAD 30330020 DC X'01' 2302 FLAG 30340020 DC X'0219' 2302 TOLERANCE 30350020 DC X'16' 2302 DSCBS/TRACK 30360020 DC X'0E' 2302 DIR BLKS/TRACK 30370020 SPACE 1 30380020 * CONTROL FOR 2303 30390020 SPACE 1 30400020 DC X'004F0009' 2303 CCHH LAST ALTERNATE 30410020 DC X'0000FFF7' 2303 CONVERSION CHANGE CYLINDERS 30420020 DC X'FFFF000A' 2303 CONVERSION GIVE CC-1 HH+XX 30430020 DC X'004F0009' 2303 CCHH LAST ORIGINAL 30440020 DC H'0' 2303 NUMBER ALTERNATES 30450020 DC H'80' 2303 VTOC-FORMAT4-FIELD9 (NO CYL) 30460020 DC H'10' 2303 NO TRACKS/CYL 30470020 DC H'4892' 2303 TRACK CAPACITY 30480020 DC X'922626' 2303 RECORD OVERHEAD 30490020 DC X'00' 2303 FLAG. 30500020 DC H'512' 2303 TOLERANCE 30510020 DC X'11' 2303 DSCBS/TRACK 30520020 DC X'0C' 2303 DIR BLKS/TRACK 30530020 SPACE 1 30540020 * CONTROL FOR 2321 30550020 SPACE 1 30560020 DC X'13090413' 2321 CCHH LAST ALTERNATE 30570020 DC X'000000ED' 2321 CONVERSION CHANGE CYLINDERS 30580020 DC X'FFFF0014' CONVERSION GIVE CC-1;HH+20 30590020 DC X'13050413' 2321 CCHH LAST ORIGINAL 30600020 DC H'400' 2321 NUMBER OF ALTERNATES 30610020 DC H'1000' 2321 VTOC-FORMAT4-FIELD9 (NO CYL) 30620020 DC H'20' 2321 NO TRKS/CYL 30630020 DC X'07D0' 2321 TRACK CAPACITY 30640020 DC X'641010' 2321 RECORD OVERHEAD. 30650020 DC X'03' 2321 FLAG 30660020 DC X'0219' 2321 TOLERANCE 30670020 DC X'08' 2321 DSCBS/TRACK 30680020 DC X'05' 2321 DIR BLKS/TRACK 30690020 SPACE 1 30700020 * CONTROL FOR 2301 30710020 SPACE 1 30720020 DC X'000000C7' 2301 CCHH LAST ALTERNATE (DUMMY) 30730020 DC X'00000001' 2301 CONVERSION; CHANGE CYL (SPEC) 30740020 DC X'FFFF0008' CONVERSION GIVE CC-1; HH+8 30750020 DC X'000000C7' 2301 CCHH;LAST ORIGINAL 30760020 DC H'0' 2301 TOTAL NUMBER OF ALTERNATES 30770020 DC H'25' 2301 NO CYL 30780020 DC H'8' 2301 NO TRKS/CYL 30790020 DC H'20483' 2301 TRACK CAPACITY 30800020 DC X'BA3535' 2301 RECORD OVERHEAD 30810020 DC X'04' 2301 FLAG 30820020 DC H'512' 2301 TOLERANCE 30830020 DC X'3F' 2301 DSCBS/TRACK 30840020 DC X'2D' 2301 DIR BLKS/TRACK 30850020 SPACE 1 30860020 * CONTROL FOR 2305 MODEL 1 30870020 SPACE 1 30880020 DC X'00300000' 23A5 CCHH LAST ALT S20201 30890020 DC X'0000FFF9' 23A5 CHANGE CYL CONV. S20201 30900020 DC X'FFFF0008' 23A5 CC-1 HH+XX CONV. S20201 30910020 DC X'002F0007' 23A5 CCHH LAST PRIMARY S20201 30920020 DC H'1' 23A5 TOTAL NO. ALTS. S20201 30930020 DC H'48' 23A5 VTOC-FMT4-FIELD9 S20201 30940020 DC H'8' 23A5 NO. TRKS/CYLINDER S20201 30950020 DC H'14568' 23A5 TRACK CAPACITY A56417 30960000 DC X'027ACA' 23A5 RECORD OVERHEAD S20201 30970020 DC X'09' 23A5 VTOC FLAG S20201 30980020 DC H'512' 23A5 TOLERANCE S20201 30990020 DC X'12' 23A5 DSCBS/TRK S20201 31000020 DC X'10' 23A5 DIRECT BLKS/TRK A43208 31010021 SPACE 1 31020020 * CONTROL FOR 2305 MODEL 2 31030020 SPACE 1 31040020 DC X'00600000' 23C5 CCHH LAST ALT. S20201 31050020 DC X'0000FFF9' 23C5 CHANGE CYL CONV. S20201 31060020 DC X'FFFF0008' 23C5 CC-1 HH+XX CONV. S20201 31070020 DC X'005F0007' 23C5 CCHH LAST ORIG. S20201 31080020 DC H'1' 23C5 TOT NO. OF ALTS. S20201 31090020 DC H'96' 23C5 VTOC-FMT4-FIELD9 S20201 31100020 DC H'8' 23C5 NO TRKS/CYLINDER S20201 31110020 DC H'14858' 23C5 TRACK CAPACITY A56417 31120000 DC X'01215B' 23C5 RECORD OVERHEAD S20201 31130020 DC X'09' 23C5 VTOC FLAG S20201 31140020 DC H'512' 23C5 TOLERANCE S20201 31150020 DC X'22' 23C5 DSCBS/TRACK S20201 31160020 DC X'1A' 23C5 DIRECT BLKS/TRK S20201 31170020 * CONTROL FOR 2314 31180020 SPACE 1 31190020 DC X'00CA0013' 2314 CCHH LAST ALTERNATE 31200020 DC X'0000FFED' 2314 CONVERSION CHANGE CYLINDERS 31210020 DC X'FFFF0014' 2314 CONVERSION GIVE CC-1 HH+XX 31220020 DC X'00C70013' 2314 CCHH LAST ORIGINAL 31230020 DC H'60' 2314 NUMBER ALTERNATES 31240020 DC X'00CB' 2314 VTOC-FORMAT4-FIELD9(NO CYL) 31250020 DC H'20' 2314 NO TRACKS/CYL 31260020 DC H'7294' 2314 TRACK CAPACITY 31270020 DC X'922D2D' 2314 RECORD OVERHEAD 31280020 DC X'01' 2314 FLAG 31290020 DC H'534' 2314 TOLERANCE 31300020 DC X'19' 2314 DSCBS/TRACK 31310020 DC X'11' 2314 DIRECTORY BLKS/TRK 6715 31320020 SPACE 1 31330020 * CONTROL FOR 3330 31340020 SPACE 1 31350020 DC X'019A0012' 3330 CCHH LAST ALT S20201 31360020 DC X'0000FFEE' 3330 CYL CHANGE CONV. S20201 31370020 DC X'FFFF0013' 3330 CC-1 HH+XX CONV. S20201 31380020 DC X'01930012' 3330 CCHH LAST ORIG. S20201 31390020 DC H'133' 3330 NO. OF ALTERNATES S20201 31400020 DC X'019B' 3330 NO. OF CYLINDERS S20201 31410020 DC H'19' 3330 NO TRKS/CYLINDER S20201 31420020 DC H'13165' 3330 TRACK CAPACITY A56417 31430000 DC X'BFBF38' 3330 RECORD OVERHEAD A56417 31440000 DC X'01' 3330 VTOC FLAG S20201 31450020 DC H'512' 3330 TOLERANCE S20201 31460020 DC X'27' 3330 DSCBS/TRACK S20201 31470020 DC X'1C' 3330 DIRECTORY BLKS/TRK S20201 31480020 SPACE 1 31490020 ADSCB DC AL3(DSCBS) 31500020 EJECT 31510020 * *********************************************** 31520020 * * CTL STATEMENT ANALYSIS ROUTINES * 31530020 * *********************************************** 31540020 CLRSCAN XC SWITCHRD(118),SWITCHRD CLEAR SCAN WORK AREA. 1095 31550020 MVI SYOCCW+7,X'80' RESET SYOUT CCW 31560020 XC CVBCOM(ONE11),CVBCOM CLEAR SWITCHES S20201 31570020 MVI BBCCHH+K1,H00 CLEAR BIN NUMBER IF ANY S20201 31580020 MVI ALTHOLD1+K3,H00 EVERYWHERE S20201 31590020 MVI SEEKADR+K1,H00 SEEK S20201 31600020 MVI SEEKIPL+K1,H00 IS S20201 31610020 MVI VBUFFR0-K1,H00 USED S20201 31620020 MVC ADR13(4),ADR13A RESET ADDRESS OF 131313 BUFFER 31630020 MVC TWENTY8H(2),TWENTY8A RESET LENGTH OF ONE-THREE BUFF 31640020 MVC FIVEER0(8),W5E RESET SURFACE ANALYSIS CCW LIST 31650020 MVC SETFMK,SAVEFMK RESTORE FILE MASK S20201 31660020 MVI EXTNTAB+7,X'00' RESET TO TRACK 0 31670020 XC DSCBS+9(5),DSCBS+9 INSURE 2ND EXTENT IS CLEARED. 31680020 MVC PASSCTR(4),F1 REINITIALIZE FOR 1 PASS/TRACK. 31690020 MVC SRCHHA1(8),SRCHHA2 REINITIALIZE FOR FLAGTEST. 31700020 LA GR14,SRCHHA1 TIC ADDRESS//DEFAULT=FLAGTEST. 31710020 STH GR14,TICSCH+2 SET UP TIC FOR FLAGTEST. 31720020 TOSCAN BAL LINK14,RDCARD LINK TO CTL CARD SCAN ROUTINE 31730020 SCANANL TM SWITCHRD,X'80' IS SCAN ERROR BIT ON 31740020 BO SCANERR GIVE SCAN ERROR MESSAGE. 31750020 TEST3 TM SWITCHRD,X'08' IS THIS A COMMAND 31760020 BC 1,CTLPRNT GO TO CTL STATEMENT PRINT 31770020 TM SWITCHRD,X'04' IS THIS A KEYWORD 31780020 BC 1,KEYLUP YES - PERFORM KEYWORD LOOKUP 31790020 B SCANERR SCAN ERROR 31800020 CTLPRNT TM SEQSW,X'02' IS SYSOUT DEFINED 31810020 BC 14,OPRLUP PERFORM COMMAND LLOKUP. 31820020 CLI JOBSW,X'00' YES, IS JOB STATEMENT PRINTED 31830020 BC 7,OPRLUP YES-BYPASS INITIAL PRINT ROUTINE 31840020 STM SCANADR,LENGTH,REGSV1 SAVE SCAN REGS 31850020 MVC PRWD+20(11),OPRMSG+30 SET UP TO PRINT DASDI HEADER. 31860020 LA GR1,31 LENGTH OF MESSAGE IN BYTES. 31870020 BAL LINK9,PRNT PRINT HEADER MESSAGE. 31880020 MVC PRWD(80),JOBSAV NO - PRINT JOB STM 31890020 BAL LINK9,WASH CALL THE PRINT ROUTINE 49363 31910000 MVC PRWD(80),MODSAV PRINT MOD STATEMENT 31920020 BAL LINK9,WASH CALL THE PRINT ROUTINE 49363 31930000 MVI JOBSAV,C' ' CLEAR 31940020 MVC JOBSAV+1(159),JOBSAV BUFFER 31950020 MVI JOBSW,X'01' SET JOB SWITCH 31960020 LM SCANADR,LENGTH,REGSV1 RESTORE SCAN REGISTERS 31970020 * OPERATOR LOOKUP ROUTINE 31980020 OPRLUP LA GR3,OPRTAB START OF COMMAND TABLE. 31990020 LA GR5,OPRTAB1 END OF COMMAND TABLE. 32000020 SCANTBL STC LENGTH,SAVLGTH SAVE LENGTH FROM SCAN. 32010020 CLI SAVLGTH,8 IS LENGTH MORE THAN 8. 32020020 BH SCANERR YES-CONTROL STATEMENT ERROR. 32030020 LA GR4,12 TABLE INCREMENTING VALUE. 32040020 MVI SARG,BLANKCOL CLEAR FIRST BYTE 32050020 MVC SARG+1(7),SARG CLEAR REST SEARCH ARGUMENT AREA. 32060020 BCTR LENGTH,0 DECREMENT LENGTH FOR EXECUTE. 32070020 EX LENGTH,OPRLUP3 MOVE PARAMETER TO STORAGE AREA. 32080020 OPRCMP CLC SARG(8),0(CSR3) TEST IF SEARCH ARGUMENT IN TABLE 32090020 BNE OPRLUP2 NO--CONTINUE SCAN OF TABLE. 32100020 LA CSR3,8(CSR3) ENTRY TO ROUTINE IN TABLE. 32110020 BR CSR3 ENTER PROPER ROUTINE. 32120020 OPRLUP2 BXLE CSR3,CSR4,OPRCMP LOOP TO CONTINUE SEARCH. 32130020 B SCANERR INVALID OPERATOR 32140020 OPRLUP3 MVC SARG(1),0(SCANADR) MOVE IN SEARCH 32150020 * KEYWORD LOOKUP ROUTINE 32160020 KEYLUP LA GR3,KEYTAB START OF KEYWORD TABLE. 32170020 LA GR5,KEYTAB1 END OF KEYWORD TABLE. 32180020 B SCANTBL GO SEARCH FOR KEYWORD. 32190020 * 32200020 JOBANL MVC JOBSAV(80),SWITCHRD+1 SAVE JOB STATEMENT 32210020 MVI EDJTSW,X'00' TURN OFF UNIT EXCP EOF SWITCH 32220020 OI SEQSW,X'01' SET SEQUENCE SWITCH 32230020 OI SWITCHRD,X'40' SET BYPASS SW ON 32240020 B TOSCAN RETURN TO SCAN 32250020 * 32260020 MODANL MVC MODSAV(80),SWITCHRD+1 SAVE MOD STATEMENT 32270020 TM SEQSW,X'01' CHECK STATEMENT SEQUENCE 32280020 BC 14,ABSEQERR SEQUENCE ERROR ROUTINE 32290020 OI SEQSW,X'02' SET SEQUENCE SWITCH 32300020 B TOSCAN RETURN TO SCAN 32310020 * 32320020 DFDANL TM SEQSW,X'03' CHECK STATEMENT SEQUENCE 32330020 BC 14,ABSEQERR SEQUENCE ERROR 32340020 OI SEQSW,X'04' SET SEQUENCE SWITCH 32350020 MVI PRNTSW,X'01' SET SWITCH TO PRINT STATEMENT. 32360020 B TOSCAN RETURN TO SCAN 32370020 * 32380020 ALTANL TM SEQSW,X'03' CHECK STATEMENT SEQUENCE 32390020 BC 14,ABSEQERR SEQUENCE ERROR 32400020 TM SEQSW,X'04' IS THIS A 2ND GETALT REQUEST 32410020 BC 14,ALTANLZ NO 32420020 MVC JOBSAV(80),SWITCHRD+1 YES, SAVE 2ND GETALT STATEMT 32430020 B GETALTYZ AND PROCESS N-1 REQUEST 32440020 ALTANLZ OI SEQSW,X'1C' SET SEQUENCE SWITCH 32450020 MVI GTALTSW,X'FF' SET GETALT FUNCTION SW - ON 32460020 MVI PRNTSW,X'01' SET SWITCH TO PRINT STATEMENT. 32470020 B TOSCAN RETURN TO SCAN 32480020 ALTRTN TM SEQSW,X'20' HAS END CARD BEEN RECEIVED 32490020 BC 1,ENDJOBX YES - PRINT END CARD 32500020 MVI BYPASS,X'00' CLEAR GETALT BYPASS SWITCH 32510020 MVI PRNTSW,X'01' SET TO PRINT STATEMENT. 32520020 B TOSCAN NO - PROCESS NEXT CTL STATEMENT 32530020 SPACE 1 32540020 ENDJOBX MVC PRWD(80),SWITCHRD+1 PRINT END STATEMENT 32550020 BAL LINK9,WASH CALL THE PRINT 49363 32570000 BC 15,EOJ PROCEED TO END OF JOB 32580020 VLDANL TM SEQSW,X'07' CHECK STAGEMENT SEQUENCE 32590020 BC 14,ABSEQERR SEQUENCE ERROR 32600020 OI SEQSW,X'08' SET RESTORE BIT IN SEQSW 32610020 MVI PRNTSW,X'01' SET SWITCH TO PRINT STATEMENT. 32620020 B TOSCAN RETURN TO SCAN 32630020 * 32640020 VTOCANL TM SEQSW,X'0F' CHECK STAGEMENT SEQUENCE 32650020 BC 14,ABSEQERR SEQUENCE ERROR 32660020 OI SEQSW,X'10' SET VTOCD SEQUENCE BIT 32670020 MVI PRNTSW,X'01' SET SWITCH TO PRINT STATEMENT. 32680020 B TOSCAN RETURN TO SCAN 32690020 * 32700020 ENDANL TM SEQSW,X'1F' CHECK STATEMENT SEQUENCE 32710020 BC 14,ABSEQERR STATEMENT SEQUENCE ERROR 32720020 OI SEQSW,X'20' SET END SEQUENCE BIT 32730020 ENDANLA TM BINSW,X'03' WAS DEVICE 2321 AND BIN REQUEST 32740020 BM SCANERR NO ERROR 32750020 TM IPLSW,X'03' WERE BOTH IPL REQ AND IPLTXT 32760020 BM SCANERR NO - ERROR 32770020 CLI GTALTSW,X'FF' IS THIS A GET ALT REQUEST 32780020 BC 8,GETALTYZ YES - PERFORM GETALT FUNCTION 32790020 TM FLGDRUM,H24 WAS 2305 AND MODEL SPEC S20201 32800020 BM SCANERR NO - ERROR S20201 32810020 MVC PRWD(80),SWITCHRD+1 SET UP 32820020 LA CSR1,80 MESSAGE BYTE COUNT 32830020 BAL LINK9,PRNT AND PRINT "END STATEMENT" 32840020 CLI KEYSEQ,X'7F' ARE ALL REQUIRED PARAMS IN 32850020 BC 7,SCANERR NO - CTL STATEMENT ERROR 32860020 CLI VOLCHKSW,X'FF' IS VOL LABEL CHK BYPASS ON 32870020 BC 8,GEN5E YES - BYPASS VOL CHK 32880020 B VOLCHK NO - PERFORM VOL LABEL CHK 32890020 LASTCARD MVC PRWD(80),SWITCHRD+1 PRINT 32900020 LA CSR1,80 LAST 32910020 BAL LINK9,PRNT CARD 32920020 B EDJTF GO TO ENDOFJOB WAIT 32930020 * 32940020 GETTEXT TM SEQSW,X'1F' 32950020 BC 14,ABSEQERR 32960020 OI IPLSW,X'02' 32970020 B ENDANLA 32980020 SPACE 1 32990020 SVMODEL BAL LINK5,GETPAR GET PARAMETER 33000020 OI KEYSEQ,X'01' SET MSG TODEV INDICATOR ON 33010020 MVC SYOMDL(4),0(SCANADR) SAVE MODEL NUMBER 33020020 LA CSR2,SYOMDL ESTABLISH UCBSYO 33030020 LA CSR3,MODTAB TABLE LIMITS START AND 33040020 LA CSR5,DEVTAB-5 END ADR RESPECTIVELY 33050020 BAL LINK9,DEVLUP 33060020 MVC UCBSYO(1),0(CSR3) SET DEVICE TYPE CODE 33070020 B TOSCAN RETURN TO SCAN 33080020 * 33090020 SVDEV BAL LINK5,GETPAR GET PARAMETER 33100020 OI KEYSEQ,X'02' SET MSG TOADDR INDICATOR ON 33110020 MVC SYODEV(3),0(SCANADR) SAVE DEVICE ADDRESS 33120020 LA CSR2,SYODEV 33130020 BAL LINK9,INTFCECK CHECK INTERFACE ADR 33140020 BC 15,SCANERR GO TO SCAN ERROR ROUTINE 33150020 STH CSR1,UCBSYO+2 SET INTERFACE ADR 33160020 B TOSCAN RETURN TO SCAN 33170020 SPACE 2 33180020 SVTOMDL CLI SEQSW,X'03' IS THIS A MSG CTL STATEMENT 33190020 BC 8,SVMODEL YES - SAVE MSG TOADDR 33200020 SPACE 2 33210020 BAL LINK5,GETPAR GET PARAMETER 33220020 OI KEYSEQ,X'04' SET DADEF TODEV INDICATOR ON 33230020 MVC TOMDL(4),0(SCANADR) SAVE TO MODEL NUMBER 33240020 CLC CK2305,TOMDL IS DEVICE 2305 S20201 33250020 BNE SVMOD NO,GET DEV TAB INFO S20201 33260020 OI FLGDRUM,H04 SET 2305 PARAM. S20201 33270020 TM FLGDRUM,H20 TEST FOR MODEL S20201 33280020 BZ TOSCAN OFF IF NO MODEL PARAM. S20201 33290020 SV2305 MVC TOMDL,CK23A5 MOVE 2305 MODEL TO TOMDL S20201 33300020 MVC SETFMK,INCR2 INHIBIT COMMAND RETRY S20201 33310020 SVMOD LA CSR2,TOMDL CHECK DASD MODEL S20201 33320020 LA CSR3,DEVTAB DEVICE TABLE LIMITS START ADR 33330020 LA CSR5,TABEND-5 AND END ADR RESPECTIVELY 33340020 BAL LINK9,DEVLUP PERFORM C/U ADR CHECK 33350020 MVC UCBTO(1),0(CSR3) SETUP UCBTO 33360020 SR REGD,REGD CLEAR REGISTER S20201 33370020 IC REGD,UCBTO PICK UP DEV TYPE CODE S20201 33380020 SLL REGD,L5 INDEX TO PROCBUFF S20201 33390020 LA REGD,PROCBUFF(REGD) ADDR CONTROL BUFFER S20201 33400020 MVC PROCBUFF(L32),L0(REGD) SAVE CONTROL BUFFER S20201 33410020 CLI UCBTO,T3330 IS DEVICE 3330 S20201 33420020 BNE SV2321 NO, TEST FOR 2321 S20201 33430020 MVC SETFMK,INCR1 YES,INHIBIT CMD RETRY S20201 33440020 SV2321 CLI UCBTO,T2321 IS DEVICE 2321 S20201 33450020 BNE SVDRUM1 NO--SKIP BINSW SET S20201 33460020 OI BINSW,H01 YES--EXPECT CELL PARM S20201 33470020 SVDRUM1 CLI UCBTO,T2301 IS DEVICE 2301 S20201 33480020 BNE SVDRUM2 NO, TEST FOR 2303 S20201 33490020 OI FLGDRUM,H01 YES, SET FLAG S20201 33500020 SVDRUM2 CLI UCBTO,T2303 IS DEVICE 2303 S20201 33510020 BNE SVTOMDL1 NO S20201 33520020 OI FLGDRUM,H02 YES, SET FLAG S20201 33530020 SVTOMDL1 XC VOWNERID(L10),VOWNERID RESET OWNER ID FIELD S20201 33540020 LM REGG,REGH,ORIGENDX MODIFY 33550020 ST REGG,STRTADR+2 ORIGENDX 33560020 BAL LINK9,MODIFYX1 FOR 33570020 STM REGG,REGH,ALTHOLD BEGINNING OF ALTERNATES 33580020 MVC EXTNTAB+20,ALTHOLD 33590020 MVC EXTNTAB+16(4),ALTHOLD SET END OF PACK 33600020 LH REGD,TOTLCNTX PUT TOTAL COUNT (MAX) 33610020 STH REGD,ROMAX+6 IN R0 COUNT FIELD 33620020 STH REGD,FIVEER0+6 AND 33630020 STH REGD,ONE3R0+6 ALL 33640020 STH REGD,FIVEER01+6 PROPER 33650020 STH REGD,READRO+6 CCWS 33660020 STH REGD,ERRSEEK1+6 SET UP ERROR RETRY CCW. 33670020 B TOSCAN RETURN 33680020 SPACE 1 33690020 SV2305AC BAL LINK5,GETPAR GET MODEL PARAMETER S20201 33700020 MVC CK23A5+L2(K1),L0(SCANADR) MOVE MODEL S20201 33710020 CLI CK23A5+L2,CHAR1 IS MODEL EQUAL 1 S20201 33720020 BNE SV2305C NO, SEE IF MODEL 2 S20201 33730020 MVI CK23A5+L2,CHARA YES, MAKE MODEL 23A5 S20201 33740020 B SV2305RT BRANCH TO RETURN S20201 33750020 SV2305C CLI CK23A5+L2,CHAR2 IS DEVICE MODEL 2 S20201 33760020 BNE SCANERR NO, CARD IN ERROR S20201 33770020 MVI CK23A5+L2,CHARC YES, MAKE MODEL 23C5 S20201 33780020 SV2305RT OI FLGDRUM,H20 SET MODEL SWITCH S20201 33790020 TM FLGDRUM,H04 TEST FOR TODEV=2305 S20201 33800020 BO SV2305 ON IF TODEV=2305 S20201 33810020 B TOSCAN ELSE READ NEXT PARAMETER S20201 33820020 * 33830020 SVTODEV CLI SEQSW,X'03' IS THIS A MSG CTL STATEMENT 33840020 BC 8,SVDEV YES - SAVE MSG TODEV 33850020 BAL LINK5,GETPAR GET PARAMETER 33860020 OI KEYSEQ,X'08' SET DADEF TOADDR INDICATOR ON 33870020 MVC TODEV(3),0(SCANADR) SAVE TO DEVICE ADDRESS 33880020 LA CSR2,TODEV CHECK DEVICE INTERFACE ADR 33890020 BAL LINK9,INTFCECK CHECK DEVICE INTERFACE ADR 33900020 B SCANERR STATEMENT ERROR 33910020 STH CSR1,UCBTO+2 STORE DEVICE ADR IN UCB 33920020 B TOSCAN RETURN 33930020 * 33940020 IPLANL BAL LINK5,GETPAR GET PARAMETER 33950020 CLC 0(3,SCANADR),YEA IS IPL REQUESTED 33960020 BNE TOSCAN NO IPL - ASSUMED STATE 33970020 MVI IPLSW,X'01' IPL IS REQUESTED 33980020 B TOSCAN RETURN 33990020 * 34000020 SVVOLID BAL LINK5,GETPAR GET PARAMETER 34010020 MVC VOLLABEL(6),BLANK CLEAR VOLID FIELD 34020020 CLC 0(6,SCANADR),SCRATCH IS THIS A SCRATCH VOLUME 34030020 BC 8,SVVOLID2 YES - BYPASS VOL CHECK 34040020 BCTR LENGTH,0 REDUCE FIELD LENGTH BY 1 34050020 EX LENGTH,IDMOVE EXECUTE MOVE OF VOLID 34060020 B TOSCAN RETURN TO SCAN NEXT FIELD 34070020 SVVOLID2 MVI VOLCHKSW,X'FF' SET VOL CHK BYPASS SW ON 34080020 B TOSCAN PROCESS NEXT PARAMETER 34090020 IDMOVE MVC VOLLABEL(1),0(SCANADR) STORE VOLID 34100020 * 34110020 TRACKANL BAL LINK5,GETPAR GET PARAMETER 34120020 LA REGF,8 IS LENGTH 34130020 CLR REGF,LENGTH 8BYTES 34140020 BC 7,SCANERR NO - CONTROL STATEMENT ERROR 34150020 LA REGF,TRACKADR+4 RIGHT ADJUST FOR CHAR INSERTION 34160020 SR REGF,LENGTH SUB LENGTH OF FIELD 34170020 BCTR LENGTH,0 REDUCE FIELD LENGTH BY 1 34180020 EX LENGTH,MOVE1 EXECUTE MOVE OF TRACKADR 34190020 OC TRACKADR-4(8),CTOEMASK CHANGE ALL "C" ZONES TO "E" 34200020 * ZONES TO SHORTEN CONVERT TABL 34210020 TR TRACKADR-4(8),ALTTT-225 CONVERT TO HEX 34220020 PACK TRACKADR(5),TRACKADR-4(9) GET RID OF ZONE BITS 34230020 CLC TRACKADR(L2),ALTENDX IS CC OF TRACK ADDR GOOD S20201 34240020 BH SCANERR NO- STATEMENT ERROR S20201 34250020 CLC TRACKADR+L2(L2),BMPTK IS HH GOOD S20201 34260020 BH SCANERR NO- STATEMENT ERROR S20201 34270020 CLC TRACKADR(4),ALTENDX IS TRACK ADDRESS VALID 34280020 BH SCANERR NO- CONTROL STATEMENT ERROR 34290020 B TOSCAN RETURN TO SCAN ROUTINE 34300020 * 34310020 GETBIN BAL LINK5,GETPAR GET PARAMETER (BIN NUMBER) 34320020 NI 0(SCANADR),X'0F' CLEAR FLAG 34330020 MVC BBCCHH+1(1),0(SCANADR) STORE BB 34340020 MVC ALTHOLD1+3(1),BBCCHH+1 EVERY WHERE 34350020 MVC SEEKADR(2),ALTHOLD1+2 SEEK 34360020 MVC SEEKIPL+1(1),BBCCHH+1 IS 34370020 MVC VBUFFR0-1(1),BBCCHH+1 USED 34380020 OI BINSW,X'02' 34390020 B TOSCAN 34400020 SPACE 1 34410020 PASSANL BAL LINK5,GETPAR GET PARAMETER 34420020 CLC 0(3,SCANADR),YEA IS BYPASS REQUESTED 34430020 BC 8,PASSYES YES 34440020 MVI BYPASS,X'00' NO - BYPASS IS NOT REQUESTED 34450020 B TOSCAN RETURN TO SCAN NEXT FIELD 34460020 PASSYES MVI BYPASS,X'FF' BYPASS IS REQUESTED 34470020 B TOSCAN RETURN TO SCAN NEXT FIELD 34480020 SPACE 1 34490020 FLAGTEST BAL LINK5,GETPAR GET THE PARAMETER. 34500020 CLC 0(2,SCANADR),NONE IS PARAMETER EQUAL 'NO'. 34510020 BNE TOSCAN NO--FLAGTEST OPTION SPECIFIED. 34520020 MVC SRCHHA1(12),NOFLAG YES-MUST WRITE HA. 34530020 B TOSCAN RETURN TO SCAN NEXT FIELD. 34540020 SPACE 1 34550020 PASSES BAL LINK5,GETPAR GET THE PARAMETER. 34560020 LA REGF,3 PUT 3 IN COMPARE REGISTER. 34570020 CLR LENGTH,REGF IS LENGTH MORE THAN 3. 34580020 BC 2,SCANERR YES-CONTROL STATEMENT ERROR. 34590020 XC PASSCTR(8),PASSCTR CLEAR THE COUNT BUFFER. 34600020 LA REGF,PASSCTR+8 END OF COUNT BUFFER. 34610020 SR REGF,LENGTH SET UP TO RIGHT JUSTIFY. 34620020 BCTR LENGTH,0 SET UP FOR EXECUTING. 34630020 EX LENGTH,MOVE1 MOVE IN THE PASS COUNT. 34640020 PACK PASSCTR(8),PASSCTR+4(4) REMOVE THE ZONES. 34650020 CVB GR2,PASSCTR CHANGE TO BINARY. 34660020 ST GR2,PASSCTR SAVE THE PASS COUNT. 34670020 CH GR2,DEC255 IS THE COUNT MORE THAN 255. 34680020 BC 2,SCANERR YES-CONTROL STATEMENT ERROR. 34690020 LTR GR2,GR2 IS THE COUNT ZERO. 34700020 BZ SCANCHK CHECK IF TODEV IS A 3330 A43889 34710021 B TOSCAN GO SCAN THE NEXT FIELD. 34720020 SCANCHK CLI UCBTO,T3330 IS DEVICE A 3330 A43889 34720521 BE TOSCAN YES, PASSES=0 IS OK A43889 34721021 B SCANERR NO, SCAN ERROR- TERM A43889 34721521 * 34730020 * VOLUME LABEL STATEMENT ANALYZATION 34740020 * 34750020 * 34760020 * VOLUME SERIAL NUMBER CHECK 34770020 * 34780020 VLSERNO BAL LINK5,GETPAR GET PARAMETER 34790020 OI KEYSEQ,X'10' SET VLD NEWVOLID INDICATOR ON 34800020 MVC VOLSERNO(6),BLANK CLEAR VOL SERIAL NO. FIELD 34810020 BCTR LENGTH,0 REDUCE FIELD LENGTH BY 1 34820020 EX LENGTH,VLMOVE EXECUTE MOVE OV VOL LABEL 34830020 B TOSCAN RETURN TO SCAN NEXT FIELD 34840020 VLMOVE MVC VOLSERNO(1),0(SCANADR) STORE VOL SERIAL NUMBER 34850020 * 34860020 * VOLUME SECURITY NUMBER CHECK 34870020 * 34880020 VLSECNO BAL LINK5,GETPAR GET PARAMETER 34890020 CLI 0(SCANADR),C'0' IS SECURITY NUMBER ZERO 34900020 BC 8,VLSECNO1 YES 34910020 CLI 0(SCANADR),C'1' IS SECURITY NUMBER ONE 34920020 BC 7,SCANERR NO - STATEMENT ERROR 34930020 VLSECNO1 MVC VOLSECNO(1),0(SCANADR) INSERT SEC NO IN VOL LABEL 34940020 B TOSCAN RETURN TO SCAN NEXT FIELD 34950020 * 34960020 * OWNER IDENTIFICATION CHECK 34970020 VLOWNER BAL LINK5,GETPAR GET PARAMETER 34980020 CLI 0(SCANADR),C' ' IS FIRST CHARACTER A BLANK 34990020 BC 8,SCANERR YES - STATEMENT ERROR 35000020 LR SCANREG,SCANADR SAVE SCANADR 35010020 VLOWNER1 MVC VOWNERID+9(1),0(SCANREG) INSERT CHAR INTO VOL LABEL 35020020 CLI 1(SCANREG),C',' IS NEXT CHARACTER A COMMA 35030020 BC 8,TOSCAN YES - END OF FIELD 35040020 CLI 1(SCANREG),C' ' IS NEXT CHARACTER A BLANK 35050020 BC 8,TOSCAN YES - END OF FIELD - RETURN 35060020 CLI VOWNERID,0 IS FIELD LENGTH EXCEEDED 35070020 BC 7,SCANERR YES - STATEMENT ERROR 35080020 MVC VOWNERID(9),VOWNERID+1 SET UP FOR NEXT INSERTION 35090020 LA SCANREG,1(0,SCANREG) INCREASE LOCATOR TO NEXT DIGIT 35100020 BC 15,VLOWNER1 INSERT NEXT CHARACTER 35110020 * 35120020 * USER LABEL SPACE CHECKING 35130020 * 35140020 VSPACE BAL LINK5,GETPAR GET PARAMETER 35150020 CLI 0(SCANADR),X'F1' IS DIGIT LESS THAN 1 35160020 BC 4,SCANERR YES - STATEMENT ERROR 35170020 CLI 0(SCANADR),X'F7' IS DIGIT GREATER THAN 7 35180020 BC 2,SCANERR YES - STATEMENT ERROR 35190020 MVN SAVSPACE(1),0(SCANADR) SAVE NUMBER FOR SPACE ALLOCATION 35200020 B TOSCAN RETURN TO SCAN NEXT FIELD 35210020 * 35220020 * VOLUME TABLE OF CONTENTS DEFINITION STATEMENT ANALYZATION 35230020 * 35240020 * VTOC ADDRESS CONVERSION AND ERROR CHECKING 35250020 VTOCDSTR BAL LINK5,GETPAR GET PARAMETER 35260020 OI KEYSEQ,X'20' SET VTOCD STRTADR INDICATOR ON 35270020 LA REGF,VTOCBGN+6 RIGHT ADJUST FOR CHAR INSERTION 35280020 SR REGF,LENGTH SUBTRACT LENGTH OF FIELD 35290020 BCTR LENGTH,0 REDUCE LENGTH OF FIELD BY 1 35300020 EX LENGTH,MOVE1 EXECUTE MOVE OF VTOCBGN 35310020 PACK CVBCOM(8),VTOCBGN(6) PACK RELATIVE VTOCBGN ADR 35320020 CVB CSR1,CVBCOM CONVERT ADR TO BINARY 35330020 LTR CSR1,CSR1 IS VTOCBGN TRACK ZERO 35340020 BC 8,VTOCERR YES-IMPROPER TRACK ADDRESS. 35350020 ST CSR1,VTOCBGN SAVE CONVERTED VTOCBGN 35360020 LR REGE,CSR1 CONVERT VTOCBGN TO CCHH FORM 35370020 BAL LINK9,ACTLADR CONVERT VTOC END ADR TO CCHH 35380020 MVC EXTNTAB+8(4),ACTRACON INSERT VTOC IN EXTENT TABLE 35390020 MVC VOLDSETD(4),ACTRACON SET VTOC ADR IN VOL LABEL 35400020 MVI VOLDSETD+4,X'01' INSERT VTOC RECORD NUMBER 35410020 XC CVBCOM(6),CVBCOM CLEAR CVBCOM 35420020 OI VTOCHCK,X'F0' INDICATE START ADR. PRESENT 35430020 B VTOCDCK CHECK IF BOTH PARMS PRESENT 1095 35440020 MOVE1 MVC 0(1,REGF),0(SCANADR) SAVE VTOC BEGIN ADR 35450020 * 35460020 * VTOCD EXTENT CHECKING 35470020 * 35480020 VTOCDEXT BAL LINK5,GETPAR GET PARAMETER 35490020 OI KEYSEQ,X'40' SET VTOCD EXTENT INDICATOR ON 35500020 LA REGF,VTOCENDX+6 RIGHT ADJUST FOR CHAR INSERTION 35510020 SR REGF,LENGTH SUBTRACT LENGTH OF FIELD 35520020 BCTR LENGTH,0 REDUCE LENGTH OF FIELD BY 1 35530020 EX LENGTH,MOVE1 EXECUTE MOVE OF VTOCD EXTENT 35540020 PACK CVBCOM(8),VTOCENDX(6) PACK RELATIVE VTOCEND ADR 35550020 CVB CSR1,CVBCOM CONVERT ADR TO BINARY 35560020 ST CSR1,VTOCEND SAVE CONVERTED VTOCEND ADR 35570020 XC CVBCOM(6),CVBCOM CLEAR CVBCOM 35580020 OI VTOCHCK,X'0F' INDICATE EXTENT PRESENT 35590020 * 35600020 * VTOCD SPACE CHECKING 35610020 * 35620020 VTOCDCK TM VTOCHCK,X'FF' ARE BOTH PARAMETERS PRESENT 35630020 BC 1,VTOCDCK1 YES 35640020 B TOSCAN SCAN NEXT FIELD 1095 35650020 VTOCDCK1 L REGE,VTOCBGN START ADR OF VTOC 35660020 L REGD,VTOCEND END ADR OF VTOC 35670020 BCTR REGD,0 END ADR OF VTOC - 1 35680020 AR REGE,REGD COMPUTED VTOC END ADR 35690020 BAL LINK9,ACTLADR CONVERT START ADR TO ACTUAL 35700020 CLC ACTRACON(4),ORIGENDX IS VTOC WITHIN DASD LIMITS 35710020 BC 2,SCANERR NO--CONTROL STATEMENT ERROR. 35720020 MVC EXTNTAB+12(4),ACTRACON INSERT VTOC INTO EXTENT TABLE 35730020 B TOSCAN SCAN NEXT FIELD 35740020 * 35750020 * DEVICE TYPE LOOKUP ROUTINE 35760020 * 35770020 * REG CSR2 CONTAINS FACTOR TO WHICH COMPARSION IS MADE 35780020 * REG CSR3 CONTAINS BEGIN ADR OF DEVICE LOOKUP TABLE 35790020 * REG CSR5 CONTAINS END ADR OF DEVICE LOOKUP TABLE 35800020 * 35810020 * REG CSR3 CONTAINS DEVICE TYPE CODE UPON RETURN TO CALLER 35820020 SPACE 2 35830020 DEVLUP LA CSR4,5 INDEX THROUGH TABLE ENTRIES 35840020 DEVLUP1 CLC 0(4,CSR2),0(CSR3) COMPARE ADR IN CSR2 TO DEVTAB 35850020 BNE DEVLUP2 NO COMPARE 35860020 LA CSR3,4(0,CSR3) RETURN CSR3 = DEVICE TYPE CODE 35870020 BR LINK9 35880020 DEVLUP2 BXLE CSR3,CSR4,DEVLUP1 CONTINUE SEARCH 35890020 B SCANERR ** ERROR 35900020 * 35910020 * CHANNEL CHECK AND CONVERSION ROUTINE 35920020 * 35930020 * REG CSR2 CONTAINS THE CHANNEL AND UNIT ON ENTRY 35940020 * REG CSR1 CONTAINS CONVERTED C/U UPON EXIT 35950020 * 35960020 * 35970020 * CHECK UNIT ADDRESS 35980020 * 35990020 INTFCECK LA CSR3,3 SET COUNTER FOR 3 DIGITS M6371 36000020 INTFCE1 TM 0(CSR2),X'F0' IS DIGIT A NUMBER 36020020 BC 1,INTFCE2 YES 36030020 CLI 0(CSR2),C'A' IS DIGIT A HEX DIGIT 36040020 BC 4,0(0,LINK9) NO - ERROR RETURN TO CALLER 36050020 CLI 0(CSR2),C'F' DIGIT LESS THAN HEX F 36060020 BC 2,0(0,LINK9) NO - ERROR RETURN TO CALLER 36070020 TR 0(1,CSR2),CONVTAB+57 YES - CONVERT TO HEX CHARACTER 36080020 INTFCE2 LA CSR2,1(0,CSR2) INCREASE LOCATOR BY 1 36090020 BCT CSR3,INTFCE1 ARE BOTH U DIGITS CHECKED 36100020 SH CSR2,CON03 RESET LOCATOR TO ORIGINAL POINT 36110020 PACK UNITADR(2),0(3,CSR2) COMBINE CHANNEL AND UNIT ADR 36120020 LH CSR1,UNITADR GET PACKED DEVICE ADR 36130020 SLL CSR1,16 CLEAR HIGH ORDER BYTES M6371 36136020 SRL CSR1,20 CLEAR SIGN FROM PACKED M6371 36142020 BC 15,4(0,LINK9) NORMAL RETURN TO CALLER 36150020 UNITADR DS 2C CONVERTED DEVICE ADDRESS 36160020 CON03 DC AL2(3) CONSTANT OF 3 36170020 * 36180020 SCANERR TM SWITCHRD,X'08' THIS ERROR OCCUR ON A COMMAND. 36190020 BC 14,SCANPRT NO--HANDLE AS PRINTED STATEMENT. 36200020 MVI PRNTSW,X'01' YES-FORCE PRINTING OF STATEMENT. 36210020 BAL GR14,RDCARD GO TO PRINT BAD STATEMENT. 36220020 SCANPRT MVC PRWD(33),SCANMSG LOAD SCAN ERROR MESSAGE. 36230020 B ERRPRINT GO TO GIVE MESSAGE. 36240020 SPACE 1 36250020 ABSEQERR TM SWITCHRD,X'08' THIS ERROR OCCUR ON A COMMAND. 36260020 BC 14,ABSEQPRT NO--HANDLE AS PRINTED STATEMENT. 36270020 MVI PRNTSW,X'01' YES-FORCE PRINTING OF STATEMENT. 36280020 BAL GR14,RDCARD GO TO PRINT BAD STATEMENT. 36290020 ABSEQPRT MVC PRWD(34),SEQMSG LOAD SEQUENCE ERROR MESSAGE. 36300020 ERRPRINT MVC PRWD+38(17),QUITJOB JOB TERMINATED PART OF MESSAGE. 36310020 LA GR1,54 SIZE OF MESSAGE. 36320020 BAL LINK9,PRNT CALL PRINT ROUTINE. 36330020 ERRWAIT LPSW COWAIT ERROR HALT WAIT STATE. 36340020 SPACE 1 36350020 SPACE 1 36360020 GETPAR BAL GR14,RDCARD SCAN FOR NEXT PARAMETER. 36370020 TM SWITCHRD,X'80' IS SCAN ERROR SWITCH ON? 36380020 BC 1,SCANERR YES-EXIT TO SCAN ERROR ROUTINE. 36390020 TM SWITCHRD,X'02' IS THIS A PARAMETER? 36400020 BC 14,SCANERR NO--EXIT TO SCAN ERROR ROUTINE. 36410020 BR LINK5 RETURN. 36420020 VTOCERR MVC PRWD(37),VTOCMSG IMPROPER TRACK ERROR MESSAGE. 36430020 B ERRPRINT 36440020 JOBSAV DS 20F JOB CARD SAVE AREA 36450020 MODSAV DS 20F MOD STATEMENT SAVE AREA 36460020 SEQMSG DC C'IBC103A STATEMENT SEQUENCE ERROR.' 36470020 SCANMSG DC C'IBC102A CONTROL STATEMENT ERROR.' 36480020 QUITJOB DC C' JOB TERMINATED. ' 36490020 VTOCMSG DC C'IBC113W IMPROPER VTOC BEGIN ADDRESS.' 36500020 CK2305 DC C'2305' 2305 DEVICE S20201 36510020 CK23A5 DC C'23A5' 2305 MODEL 1 OR 2 S20201 36520020 EJECT 36530020 * COMMAND LOOKUP TABLE 36540020 * 36550020 DS 0F 36560020 OPRTAB DC C'JOB ' 36570020 B JOBANL 36580020 DC C'MSG ' 36590020 B MODANL 36600020 DC C'DADEF ' 36610020 B DFDANL 36620020 DC C'VLD ' 36630020 B VLDANL 36640020 DC C'VTOCD ' 36650020 B VTOCANL 36660020 DC C'LASTCARD' 36670020 B LASTCARD 36680020 DC C'GETALT ' 36690020 B ALTANL 36700020 TEXTX DC C'IPLTXT ' 36710020 B GETTEXT 36720020 OPRTAB1 DC C'END ' 36730020 B ENDANL 36740020 * KEYWORD LOOKUP TABLE 36750020 * 36760020 KEYTAB DC C'TODEV ' 36770020 B SVTOMDL 36780020 DC C'TOADDR ' 36790020 B SVTODEV 36800020 DC C'IPL ' 36810020 B IPLANL 36820020 DC C'VOLID ' 36830020 B SVVOLID 36840020 DC C'NEWVOLID' 36850020 B VLSERNO 36860020 DC C'VOLPASS ' 36870020 B VLSECNO 36880020 DC C'OWNERID ' 36890020 B VLOWNER 36900020 DC C'ADDLABEL' 36910020 B VSPACE 36920020 DC C'STRTADR ' 36930020 B VTOCDSTR 36940020 DC C'TRACK ' 36950020 B TRACKANL 36960020 DC C'BYPASS ' 36970020 B PASSANL 36980020 DC C'FLAGTEST' 36990020 B FLAGTEST 37000020 DC C'PASSES ' 37010020 B PASSES 37020020 DC C'BIN ' 37030020 B GETBIN 37040020 DC C'MODEL ' MODEL PARAMETER S20201 37050020 B SV2305AC BR TO CHECK MODEL TYPE S20201 37060020 KEYTAB1 DC C'EXTENT ' 37070020 B VTOCDEXT 37080020 * 37090020 * DEVICE LOOKUP TABLE 37100020 * 37110020 * EACH DEVICE SUPPORTED BY IBCDASDI IS ASSIGNED A UNIQUE 37120020 * HEXADECIMAL CODE WHICH IS RETRIEVED FROM THE DEVICE LOOKUP 37130020 * TABLE AND STORED IN THE APPROPRIATE UCB. THE CHOICE OF 37140020 * ONE-BYTE CODES IS RESTRICTED AS FOLLOWS: 37150020 * * ALL DASD DEVICES MUST RECEIVE A CODE VALUE LOWER THEN 37160020 * THE LOWEST CODE ASSIGNED TO A UNIT RECORD OR TAPE 37170020 * DEVICE. THE LABEL 'DASDMAX' IS EQUATED TO THE HIGHEST 37180020 * CODE ASSIGNED TO A DASD DEVICE AND FACILITATES 37190020 * RECOGNITION OF DASD ERRORS. 37200020 SPACE 2 37210020 SYINTAB DC C'1402' DEVICE TYPE S20201 37220020 DC X'10' DEVICE CODE S20201 37230020 DC C'2540' DEVICE TYPE S20201 37240020 DC X'10' DEVICE CODE S20201 37250020 DC C'1442' DEVICE TYPE S20201 37260020 DC X'20' DEVICE CODE S20201 37270020 DC C'2501' DEVICE TYPE M5714 37272020 DC X'20' DEVICE CODE M5714 37274020 DC C'2520' DEVICE TYPE M5714 37276020 DC X'20' DEVICE CODE M5714 37278020 DC C'2400' DEVICE TYPE S20201 37280020 DC X'30' DEVICE CODE S20201 37290020 DC C'3410' DEVICE TYPE M1828 37292000 DC X'30' DEVICE CODE M1828 37294000 DC C'3420' DEVICE TYPE M1828 37296000 DC X'30' DEVICE CODE M1828 37298000 MODTAB DC C'1403' DEVICE TYPE S20201 37300020 DC X'40' DEVICE CODE S20201 37310020 DC C'3211' DEVICE TYPE S20201 37320020 DC X'40' DEVICE CODE S20201 37330020 DC C'1443' DEVICE TYPE S20201 37340020 DC X'50' DEVICE CODE S20201 37350020 DC C'1052' DEVICE TYPE S20201 37360020 DC X'60' DEVICE CODE S20201 37370020 DC C'3210' DEVICE TYPE S20201 37380020 DC X'60' DEVICE CODE S20201 37390020 DC C'2400' DEVICE TYPE S20201 37400020 DC X'30' DEVICE CODE S20201 37400400 DC C'3410' DEVICE TYPE M1828 37402000 DC X'30' DEVICE CODE M1828 37402400 DC C'3420' DEVICE TYPE M1828 37404000 DC X'30' DEVICE CODE M1828 37410000 DEVTAB DC C'2311' DEVICE TYPE S20201 37420020 DC X'01' DEVICE CODE S20201 37430020 DC C'2302' DEVICE TYPE S20201 37440020 DC X'02' DEVICE CODE S20201 37450020 DC C'2303' DEVICE TYPE S20201 37460020 DC X'03' DEVICE CODE S20201 37470020 DC C'2321' DEVICE TYPE S20201 37480020 DC X'04' DEVICE CODE S20201 37490020 DC C'2301' DEVICE TYPE S20201 37500020 DC X'05' DEVICE CODE S20201 37510020 DC C'23A5' 2305 MODEL 1 S20201 37520020 DC X'06' DEVICE CODE S20201 37530020 DC C'23C5' 2305 MODEL 2 S20201 37540020 DC X'07' DEVICE CODE S20201 37550020 DC C'2314' DEVICE TYPE S20201 37560020 DC X'08' DEVICE CODE S20201 37570020 DC C'3330' DEVICE TYPE S20201 37580020 DC X'09' DEVICE CODE S20201 37590020 TABEND DS 0F S20201 37600020 * 37610020 * DEVICE ID EQUATES 37620020 * 37630020 T2311 EQU X'01' 2311 INDEX S20201 37640020 T2302 EQU X'02' 2302 INDEX S20201 37650020 T2303 EQU X'03' 2303 INDEX S20201 37660020 T2321 EQU X'04' 2321 INDEX S20201 37670020 T2301 EQU X'05' 2301 INDEX S20201 37680020 T23A5 EQU X'06' 305 MODEL 1 S20201 37690020 T23C5 EQU X'07' 305 MODEL 2 S20201 37700020 T2314 EQU X'08' 2314 INDEX S20201 37710020 T3330 EQU X'09' 3330 INDEX S20201 37720020 SPACE 1 37730020 T1402 EQU X'10' 1402 CODE S20201 37740020 T2540 EQU X'10' 2540 CODE S20201 37750020 T1442 EQU X'20' 1442 CODE S20201 37760020 T2501 EQU X'20' 2501 CODE M5714 37763020 T2520 EQU X'20' 2520 CODE M5714 37766020 T2400 EQU X'30' TAPE CODE S20201 37770020 T1403 EQU X'40' 1403 CODE S20201 37780020 T1443 EQU X'50' 1443 CODE S20201 37790020 T1052 EQU X'60' 1052 CODE S20201 37800020 SPACE 1 37810020 DASDMAX EQU X'09' HIGHEST DASD ID CODE S20201 37820020 SPACE 2 37830020 EXTNTAB DC 6F'0' EXTENTS FOR FORMAT 5 DSCB 37840020 EJECT 37850020 SPACE 3 37860020 * ROUTINE TO CALCULATE SEEK ADDRESS 37870020 SPACE 2 37880020 ACTLADR ST REGE,ACTRACON SAVE TRK ADDR INCASE 2301 37890020 CLI UCBTO,T2301 IS DEVICE 2301 S20201 37900020 BCR 8,LINK9 YES, FINISHED 37910020 LH REGC,TCTABLE GET CONVERT FACTOR 37920020 SR REGD,REGD CLEAR REGISTER 37930020 DR REGD,REGC DVD RTA/TC REGD-HH REGE-CC 37940020 ST REGD,ACTRACON CONTAINS HH 37950020 CLI UCBTO,T2321 IS DASD TYPE 2321 S20201 37960020 BC 8,MOD2321 YES - CALCULATE 2321 ADDRESS 37970020 STH REGE,ACTRACON NON 2321 CONTAINS CC M4946 37980020 BR LINK9 RETURN 37990020 MOD2321 SR REGD,REGD CLEAR FOR DEVIDE 38000020 SRL REGC,2 NO CYL/STRIP (20/4)=5 38010020 DR REGD,REGC DVD CYL/5 REGD=CYL;REGE=STRIP 38020020 STC REGD,ACTRACON+2 CONTAINS NUMBER CYLINDERS 38030020 SR REGD,REGD CLEAR 38040020 SLL REGC,1 NO STRIPS/SCELL (5X2)=10 38050020 DR REGD,REGC DVD STRIP/10 REGD=STRIP REGE=SC 38060020 STC REGD,ACTRACON+1 NUMBER OF STRIPS 38070020 STC REGE,ACTRACON NUMBER OF SUBCELLS 38080020 BR LINK9 RETURN 38090020 SPACE 3 38100020 EJECT 38110020 MODIFYXZ CLC STRTADR+2(4),ORIGENDX FINISED WITH ORIGINALS 38120020 BE CONSTR1 YES 38130020 SPACE 1 38140020 MODIFYX1 L REGG,STRTADR+2 GET CURRENT ADDRESS 38150020 CLC STRTADR+5(1),BMPTK+1 LAST TRACK OF CYLINDER 38160020 BE CHANGEX YES, CHANGE CYLINDERS 38170020 A REGG,F1 NO - INCRIMENT 38180020 B CHANGEX1 STORE AGAIN 38190020 SPACE 1 38200020 CHANGEX A REGG,CNGCYLX CHANGE CYLINDERS 38210020 CLI STRTADR+4,X'04' 2321 CYLINDER CHANGE NECESSARY 38220020 BE CKCYL21 YES 38230020 CHANGEX1 ST REGG,STRTADR+2 STORE AGAIN 38240020 BR LINK9 RETURN 38250020 SPACE 1 38260020 CKCYL21 AL REGG,Z000FB00 UPDATE CYLINDER 38270020 CLI STRTADR+3,X'09' END OF STRIP 38280020 BC 7,CHANGEX1 NO - RETURN 38290020 AL REGG,Z0F60000 YES - UPDATE SUBCELL 38300020 B CHANGEX1 RETURN 38310020 SPACE 1 38320020 F1 DC F'1' INCRIMENT TO BUMP TRACK 38330020 F2 DC F'2' COMPARISON CONSTANT. 38340020 Z000FB00 DC X'0000FB00' CHANGE STRIPS 38350020 Z0F60000 DC X'00F60000' CHANGE SUBCELLS 38360020 EJECT 38370020 VOLCHK BAL LINK15,CKVOLLBL PERFORM VOLUME LABEL CHECK 38380020 * 38390020 GEN5E TM FLGDRUM,X05 CHECK FOR 2301 OR 2305 S20201 38400020 BO MOVEL13 YES, FIX LOOP CNT AT 32 S20201 38410020 CLI UCBTO,T3330 IS THIS A 3330 S20201 38420020 BE INTALT NO NEED TO SET BUFFER S20201 38430020 GEN5EA MVC ONE3R0+1(3),ADR13+1 SET 13 BUFFER ADDR IN CCW 38440020 TM IPLSW,X'03' IPL REQUESTED AND TEXT SUPPLIED 38450020 BM SCANERR JUST ONE OF ABOVE 38460020 BC 8,GEN5E1 NO IPL-BYPASS TRACK ONE CHECK. 38470020 CLI UCBTO,T2303 IS THIS A 2303 DEVICE S20201 38480020 BE VTOCTST YES, CHECK VTOC ADDRESS S20201 38490020 CLI UCBTO,T2311 IS THIS A 2311 DEVICE S20201 38500020 BNE GEN5E1 NO, BYPASS VTOC CHECK S20201 38510020 VTOCTST CLC F1(L4),VTOCBGN IS VTOC ON TRK 1 S20201 38520020 BC 8,VTOCERR YES-GIVE MESSAGE AND TERMINATE. 38530020 GEN5E1 LM GR8,GR9,ADR13 5E,13 BASE REGS. S20201 38540020 LH REGF,TWENTY8H LOOP COUNTER 38550020 LA REGE,TAB5E+1 ADR OF HEX E5 BLOCK 38560020 MVI TAB5E,X'55' SET TO GENERATE HEX '55'. 38570020 CLI UCBTO,T2321 IS THIS A 2321 DEVICE S20201 38580020 BNE LOOP5E NO--PATTERN IS OKAY. 38590020 MVI TAB5E,X'E5' YES-SET FOR A 'E5' PATTERN. 38600020 LOOP5E MVC 0(256,REGE),TAB5E PROPOGATE HEX 5E IN CORE 38610020 LA REGE,256(REGE) STEP REGE TO NEXT 256 GROUP 38620020 BCT REGF,LOOP5E LOOP RETURN 38630020 SPACE 1 38640020 CLI UCBTO,T2321 IS THIS A 2321 DEVICE S20201 38650020 BE LOOP13A YES, BY PASS GEN 13 38660020 SPACE 1 38670020 LH REGF,TWENTY8H LOOP COUNTER 38680020 LA REGE,K1(GR8) LOAD BUFFER ADDRESS S20201 38690020 MVI L0(GR8),H00 SETUP TO GEN X'00' S20201 38700020 LOOP13 MVC L0(TWO56,REGE),L0(GR8) SET BUFFER TO HEX 00 S20201 38710020 LA REGE,256(REGE) STEP REGE TO NEXT 256 GROUP 38720020 BCT REGF,LOOP13 LOOP RETURN 38730020 LOOP13A CLI GTALTSW,X'FF' IS THIS A GET ALT REQUEST 38740020 BC 8,SEEK YES, CHECK THE TRACK 38750020 B INTALT INITIALIZE ALT TRACKS 38760020 SPACE 1 38770020 MOVEL13 MVC ADR13(4),AD132301 38780020 MVC TWENTY8H(2),EIGHTY2H 38790020 B GEN5EA 38800020 SPACE 2 38810020 * INITIALIZE ALTERNATE TRACKS ROUTINE 38820020 * 38830020 INTALT MVC SAVEVTOC+8(6),ALTHOLD STORE BEGINNING ALT AND COUNT 38840020 MVC STRTADR(6),ALTHOLD-2 PREPARE TO CHECK ALTERNATES 38850020 MVI STRTADR+1,X'01' SET ALTERNATE FLAG. 38860020 L RTRKADR,ALTHOLD SET REGISTER FOR 2321 38870020 CLI UCBTO,T2321 IS THIS A 2321 DEVICE S20201 38880020 BE WRITECTA YES 38890020 CLI UCBTO,T3330 IS THIS A 3330 DEVICE S20201 38900020 BE INTXX YES, NO MORE CCW CHANGES S20201 38910020 FORM3330 CLI BYPASS,X'FF' BYPASS SURFACE ANALYSIS A43889 38920021 BNE TESTDRM NO--GO SEE IF THIS IS A DRUM. 38930020 MVC FIVEER0(8),TICWR0 YES, SET CCW LIST TO DO SO 38940020 MVC SRCHHA1(8),SRCHHA2 INSURE FLAG IS TESTED. 38950020 LA GR15,SRCHHA1 TIC ADDRESS. 38960020 STH GR15,TICSCH+2 SET UP THE TIC. 38970020 TESTDRM TM FLGDRUM,H07 IS THIS A DRUM DEVICE S20201 38980021 BZ INTALTR NO, MAY BE FLAGTEST S20201 38990020 NOFLGTST MVC SRCHHA1(L12),NOFLAG SET FOR NO FLAG TEST S20201 39000020 CLI BYPASS,X'FF' IS THE BYPASS OPTION SPECIFIED. 39010020 BNE INTALTR NO--GO TO SURFACE ANALYSIS. 39020020 MVC TICSCH(8),TICWR0 YES-MOVE UP TIC TO FORMAT. 39030020 SPACE 1 39040020 INTALTR CLC STRTADR+2(4),ALTENDX LAST ALTERNATE 39050020 BH INTORG YES, CHECK ORIGINALS 39060020 MVC SEEKADR+2(4),STRTADR+2 ESTABLISH SEEK ADR 39070020 TM FLGDRUM,H04 IS DEVICE A 2305 S20201 39080020 BNO NTZEUS BRANCH IF NOT S20201 39090020 SPACE 1 39092021 CLI GTALTSW,X'FF' CHECK GETALT RTN M0990 39092421 BE CONT1 M0990 39093221 CLI BYPASS,X'FF' IS THE BYPASS OPTION SPECIFIED.M0990 39094021 BE ALTZEUS YES--DO NOT REMOVE ALT M0990 39096021 CONT1 EQU * 39098021 MVI STRTADR+K1,H02 SET BIT 6 TO REMOVE ALT S20201 39100020 MVI XXXR0+L4,H20 SET CCW FOR 2305 SPARING S20201 39110020 NTZEUS BAL LINK15,INITRK DO TRACK CHECK S20201 39120020 MVI STRTADR+K1,H00 TURN OFF BIT 6 S20201 39130020 MVI XXXR0+L4,H40 RESTORE CCW S20201 39140020 B INTALTR RETURN TO PROCESS NEXT TRACK 39150020 * 39160020 ALTZEUS BAL LINK15,INITRK DO TRACK CHECK M0990 39162021 MVI ALTCNTX+1,H01 SET THE ALTERNATE COUNT TO ONE M0990 39164021 INTORG MVC SAVEVTOC+8(6),ALTHOLD RESTORE ALTERNATE COUNT 39170020 MVC STRTADR(6),CLEAR CLEAR STARTING ADDRESS 39180020 SPACE 1 39190020 SEEK MVC SEEKADR+2(4),STRTADR+2 SEEK PROPER TRACK 39200020 BAL LINK15,INITRK GO TO CHECK TRACK 39210020 B SEEK RETURN 39220020 SPACE 2 39230020 INITRK STM 0,15,REGSV8 SAVE REGS 39240020 MVC ROCOUNT(4),STRTADR+2 INSERT CURRENT CCHH IN ROCOUNT 39250020 MVC ROMAX(4),STRTADR+2 INSERT CURRENT CCHH IN ROMAX 39260020 LM GR8,GR9,ADR13 ESTABLISH 5E,13 BASE REGS S20201 39270020 MVC TAB5E(8),ROMAX MOVE RO COUNT FIELD TO TAB5E 39280020 MVC L0(L8,GR8),ROMAX MOVE R0 CNT FLD TO TAB13 S20201 39290020 MVI SPIOSW,X'F0' SET TRACK CHECK SWITCH 39300020 L IOLOOP,PASSCTR SET FOR NUMBER OF PASSES. 39310020 CL IOLOOP,F1 WILL THERE BE ONE PASS ONLY. 39320020 BE SEEKRTN YES-GO DO IT. 39330020 MVC SRCHHA3(8),XXXHA NO--SET UP TO READ FLAG SOONER. 39340020 MVI SRCHHA3+4,X'00' TURN OFF THE CHAIN BIT. 39350020 * 39360020 * WRITE AND VERIFY HEX '55' BYTE PATTERNS. 39370020 * WRITE AND VERIFY HEX '00' BYTE PATTERNS. 39380020 * 39390020 SEEKRTN LA UCBREG,UCBTO POINTER TO DASD DEVICE UCB 39400020 LA CCWREG,WRITE5E CCW LIST ADR WRITE 5E 39410020 TM FLGDRUM,H04 IS DEVICE A 2305 S20201 39420020 BNO NZEUS BRANCH IF NOT S20201 39430020 TM STRTADR+K1,H02 REMOVE ALTERNATE SPARE S20201 39440020 BNO NZEUS BRANCH IF NOT S20201 39450020 LA CCWREG,SPARZEUS CCW LIST WRITE HA 2305 S20201 39460020 NZEUS MVI FLAG,H00 CLEAR FLAG AREA S20201 39470020 BAL LINK9,STARTIO ISSUE SIO 39480020 TM FLAG,X'02' WAS THIS A DEFECTIVE TRACK. 39490020 BO GETALT3 YES-FLAG BAD/ASSIGN ALTERNATE. 39500020 TESTCNT CL IOLOOP,F2 WILL THERE BE ONE MORE PASS. 39510020 BNE TESTLOOP NO--DON'T MODIFY THE CCW LIST. 39520020 MVC SRCHHA3(8),SRCHHA2 REPEAT SEARCH ON HA CCW. 39530020 TESTLOOP BCT IOLOOP,SEEKRTN ERROR-RETRY TEN TIMES. 39540020 LM 0,15,REGSV8 RESTORE REGS 39550020 CLI GTALTSW,X'FF' IS THIS A GETALT REQUEST 39560020 BC 8,GETALT2 RETURN TO GETALT ROUTINE 39570020 BAL LINK9,MODIFYXZ INCRIMENT TRACK NUMBER 39580020 BR LINK15 RETURN TO CALLER 39590020 SPACE 2 39600020 * 39610020 * CHECK ALTERNATE TRACKS ONLY - 3330 39620020 * 39630020 INTXX MVI ALTSW,H01 SWT FOR NEXT AVAILABLE S20201 39640020 CLI PASSCTR+3,X'00' DOES PASSES=0 A43889 39640421 BE INTXX1 YES,DO QUICK DASDI A43889 39640821 MVI BYPASS,X'FF' SET BYPASS SWITCH A43889 39641221 B FORM3330 BR TO FORMAT 3330 A43889 39641621 INTXX1 CLC STRTADR+L2(L4),ALTENDX LAST ALTERNATE S20201 39650020 BH INTXX2 YES,BUILD TRK 0 S20201 39660020 MVC SEEKADR+L2(L4),STRTADR+L2 ESTABLISH SEEK ADDR. S20201 39670020 MVI SPIOSW,H00 SET TRK CHK SWITCH OFF S20201 39680020 MVI HABUFR,H00 INSURE FLAG AREA CLEAR S20201 39690020 BAL LINK14,GETHAR0 BRANCH TO READ HA AND R0 S20201 39700020 TM HABUFR,H02 WAS LAST A DEFECTIVE TRK S20201 39710020 BO ALTDECR YES,DECREMENT ALT CNT S20201 39720020 TM HABUFR,H01 HAS ALT TRK BEEN ASSIGNED S20201 39730020 BO ALTDECR YES DECR AVAILABLE ALTS. S20201 39740020 NI ALTSW,H00 TRACK AVAIL.,TURN SWT OFF S20201 39750020 BAL LINK9,MODIFYXZ BUMP POINTER TO NEXT ALT S20201 39760020 B INTXX1 PROCESS NEXT TRACK S20201 39770020 SPACE 1 39780020 ALTDECR BAL LINK9,MODIFYXZ BUMP PTR TO NEXT TRACK S20201 39790020 LH REGE,ALTCNTX GET CNT OF ALTS. LEFT S20201 39800020 BCTR REGE,R0 DECREMENT BY 1 S20201 39810020 STH REGE,ALTCNTX STORE NEW COUNT S20201 39820020 TM ALTSW,H01 ANY AVAILABLE ALTS. S20201 39830020 BZ INTXX1 YES, LEAVE NEXT-ALT PTR S20201 39840020 C REGG,ALTENDX 3330 TRK ADDR EXCEEDED S20201 39850020 BH INTXX2 BRANCH YES S20201 39860020 ST REGG,ALTHOLD NO,BUMP PTR TO NEXT ALT S20201 39870020 B INTXX1 PROCESS NEXT ALTERNATE S20201 39880020 SPACE 1 39890020 INTXX2 MVC SAVEVTOC+L8(K6),ALTHOLD RESTORE ALTERNATE COUNT S20201 39900020 B CONSTR1 GO CONSTRUCT TRACK 0 S20201 39910020 SPACE 3 39920020 ADR13 DC A(TAB13) BASE REG FOR TAB13 39930020 ADR5E DC A(TAB5E) BASE REG FOR TAB5E 39940020 AD132301 DC X'0000A000' BASE REG FOR TAB13(2301) 39950020 TWENTY8H DC H'28' A30811 39960020 EIGHTY2H DC H'82' 39970020 SPACE 1 39980020 ADR13A DC A(TAB13) 39990020 TWENTY8A DC H'28' A30811 40000020 EJECT 40010020 * CONSTRUCT AND WRITE TRACK ZERO 40020020 * 40030020 CONSTR1 SR REGG,REGG CLEAR REG 40040020 L GR9,ADR5E RESTORE TAB5E BASE REG. S20201 40050020 MVC SAVECCWS(250),WRTZERTR SAVE CCWS AS IS TO MAKE 40060020 * REINTERANT 40070020 MVI SPIOSW,X'00' CLEAR SURFACE CHK SW 40080020 IC REGG,SAVSPACE GET NUMBER OF USER LABELS 40090020 LR REGH,REGG NUMBER OF ADDITIONAL LABELS 40100020 LTR REGH,REGH USER LABELS SPECIFIED 40110020 BC 7,YESUSER YES--MODIFY COUNT ACCORDINGLY. 40120020 SPACE 1 40130020 LA REGH,WRTVOLAB R3 CCW LAST; SAVE ADDR 40140020 B NOUSER BYPASS USER CCW MODIFICATION 40150020 SPACE 1 40160020 YESUSER BCTR REGH,0 REDUCE COUNT BY 1. 40170020 SLL REGH,3 MULTIPLY BY 8 40180020 LA REGH,LABELS(REGH) GET ADR OF FLAG BYTE 40190020 NOUSER LA REGG,4(REGG) IPL EXT RECORD NUMBER 40200020 TM IPLSW,X'03' IPL TEXT REQUESTED 40210020 BO LOADA YES, GO GET IT 40220020 MVI 4(REGH),X'00' NO, SET CHAIN BIT OFF 40230020 MVC IPLNOCHG+1(3),AIPLABST+1 WRITE WAIT STATE IPL RECORD 40240020 B CONSTR2 PREPARE TO WRITE TRACK ZERO. 40250020 SPACE 1 40260020 VCKIPL CLI UCBTO,T2311 IS DEVICE 2311 S20201 40270020 BE VCKIPL1 YES, WRITE IPL TXT ON TRACK 1 40280020 CLI UCBTO,T2302 IS DEVICE 2302 S20201 40290020 BE VCKIPL1 YES, WRITE IPL TXT ON TRACK1 40300020 CLI UCBTO,T2303 IS DEVICE 2303 S20201 40310020 BNE TXT2301 NO, WRITE IPLTEXT ON TRACK 0 40320020 VCKIPL1 MVI 4(REGH),X'00' SET TRACK 0 CHAIN BIT OFF 40330020 LA REGD,SRCHADR TRACK 1 TO BE USED 40340020 MVC SEEKADR+2(4),0(REGD) STROE IN SEEK ADDRESS 40350020 LA UCBREG,UCBTO ADR OF DASD UCB 40360020 LA CCWREG,SEEKIPLX CCW LIST TO CHECK IF ALT TRACK 40370020 BAL LINK9,STARTIO ISSUE SIO 40380020 CLI HABUFR,X'02' HOME ADDR INDICATES IF BAD TRACK 40390020 BC 7,WRTIPL TRACK IS GOOD, WRITE NORMAL 40400020 LA REGD,VBUFFR0 LOAD ADDR OF ALT TRACK 40410020 * 40420020 WRTIPL MVC SEEKIPL+2(4),0(REGD) INSERT IPL INIT CCHH IN SEEKIPL 40430020 MVI EXTNTAB+7,X'01' IPL TXT ON TRACK 1 40440020 LA CCWREG,IPLSEEK ADR OF CCW LIST 40450020 BAL LINK9,STARTIO ISSUE SIO 40460020 CONSTR2 LA UCBREG,UCBTO POINTER TO DASD DEVICE UCB 40470020 MVC STRTADR(6),CLEAR SET TO ZERO TO WRITE TRK ZERO 40480020 MVC SEEKADR+2(4),CLEAR SET TO ZERO TO WRITE TRK ZERO 40490020 LA CCWREG,WRTZERTR CCW ADR FOR TRACK ZERO WRITE 40500020 BAL LINK9,STARTIO ISSUE SIO 40510020 L GR9,ADR5E RESTORE TAB5E BASE REG. S20201 40520020 MVC WRTZERTR(250),SAVECCWS RESTORE CCWS TO MAKE REINTERANT 40530020 B FMTVTOC FORMAT VTOC DSCBS 40540020 SPACE 1 40550020 TXT2301 MVC 8(8,REGH),TIC2301 CHAIN IPLTEXT RECORD ON 0 40560020 STC REGG,IPLADR+4 SET R OF CCHHR 40570020 XC IPLADR(4),IPLADR BE SURE TRACK 0 40580020 MVC SEEKIPL+2(4),IPLADR RESET IPL ADDRESS 40590020 MVC SRCHADR(5),IPLADR FOR BOOTSTRAP 40600020 B CONSTR2 WRITE TRACK ZERO 40610020 SPACE 1 40620020 SEEKIPLX CCW 7,SEEKADR,X'40',6 40630020 CCW X'1F',SETFMK,X'40',1 40640020 CCW X'1A',HABUFR,X'60',5 40650020 CCW X'16',VBUFFR0,X'20',16 40660020 SEEKIPL1 CCW 7,BBCCHH,X'40',6 SEEK DEFECTIVE TRACK. 40670020 CCW 8,SEEKIPLX+8,0,0 40680020 SPACE 1 40690020 VBUFFR0X DC H'0' 40700020 DC H'0' 40710020 VBUFFR0 DS 4F 40720020 HABUFR DC X'0000000000' 40730020 ALTCCWX CCW 7,VBUFFR0-2,X'60',6 40740020 CCW 8,SETMASK,X'60',5 40750020 * ABSOLUTE LOADER FOR IPL TXT INPUT 40760020 * 40770020 LOADA MVC IPLNOCHG+1(3),AIPLPRES+1 SET UP LOAD AND GO PSW. 40780020 LOAD LA GR2,BF1 ADDRESS OF IPL READ IN BUFFER 40790020 BAL LINK15,SYSIN READ A CARD 40800020 L GR4,IPLCORE ADDRESS OF IPL CORE RESIDENCE 40810020 CLC BF1+1(3),END IS THIS AN END CARD 40820020 BC 8,ENDWRT1 YES, PRINT IT 40830020 CLC BF1+1(3),TXT IS THIS A TXT CARD 40840020 BNE LOAD NO% SKIP IT 40850020 MVI TEXTSW,X'01' SET SWITCH TELLING A TEXT CARD 40860020 * HAS BEEN WRITTEN 40870020 B LOAD1 PROCESS THE CARD 40880020 SPACE 1 40890020 ENDWRT1 CLI TEXTSW,X'00' WAS AT LEAST ONE TEXT CARD READ 40900020 BE ABSEQERR NO - SEQUENCE ERROR 40910020 MVC PRWD(80),BF1 PRINT END STATEMENT 40920020 LA CSR1,80 LOAD LENGTH OF END CARD 1673 40930020 BAL LINK9,PRNT CALL PRINT ROUTINE 40940020 OI SEQSW,X'20' 40950020 B VCKIPL 40960020 SPACE 2 40970020 * LOAD TXT CARD INTO CORE 40980020 * 40990020 LOAD1 LH GR2,BYTE GET BYTE COUNT 41000020 BCTR GR2,0 REDUCE IT BY ONE 41010020 STC GR2,LOAD3+1 STORE INTO MOVE 41020020 L GR5,ADR GET TXT ADR 41030020 AR GR5,GR4 INCREMENT ADR BY OFFSET 6000 41040020 LOAD3 MVC 0(1,GR5),TEXT LOAD TEXT INTO CORE 41050020 B LOAD GO GET NEXT CARD 41060020 SPACE 2 41070020 * BUFFER FOR TXT INPUT READ 41080020 * 41090020 DS 0D 41100020 BF1 DS 4C 41110020 ADR DS 6C 41120020 BYTE DS 6C 41130020 TEXT DS 64C 41140020 TXT DC C'TXT' 41150020 END DC C'END' 41160020 * 41170020 * IPL INITIALIZATION PGM WRITE ROUTINE 41180020 * 41190020 EOJ MVC PRWD(20),EOJMSG PRINT END OF JOB MESSAGE. 41200020 LA CSR1,20 LENGTH OF MESSAGE IN BYTES. 41210020 BAL LINK9,PRNT PRINT MESSAGE ROUTINE 41220020 EDJT MVI EDJTSW,X'01' SET END OF TASK SWITCH 41230020 B CLRSCAN SEE IF STACKED JOBS 41240020 EDJTF CLI UCBSYO,T2400 IS SYSOUT TAPE S20201 41250020 BC 8,TAPEEOF YES - WRITE TAPE EOF AND REWIND 41260020 LPSW COWAIT EOJ TERMINATE WAIT 41270020 TAPEEOF LA UCBREG,UCBSYO ADR OF SYSOUT UCB 41280020 LA CCWREG,TAPECCW ADR OF CCW LIST 41290020 BAL LINK9,STARTIO ISSUE SIO 41300020 LPSW COWAIT EOJ TERMINATE WAIT 41310020 SPACE 1 41320020 EOJMSG DC C'IBC163A END OF JOB.' 41330020 DS 0D 41340020 TAPECCW CCW X'1F',CLEAR,X'40',1 WRITE TAPE EOF 41350020 CCW X'07',CLEAR,X'20',1 REWIND AND UNLOAD 41360020 EJECT 41370020 * *********************** 41380020 * * REGISTER ASSIGNMENT * 41390020 * *********************** 41400020 SPACE 2 41410020 RVTOCADD EQU 1 41420020 RUCBREG EQU 2 41430020 RWRKREG5 EQU 2 41440020 RCCWREG EQU 3 41450020 RBCNTRL EQU 4 41460020 RSTOPB EQU 5 41470020 RBUPDATE EQU 6 41480020 RWRKREG6 EQU RBUPDATE 41490020 RWRKREG3 EQU 8 S20201 41500020 RWRKREG4 EQU 7 S20201 41510020 RLINK9 EQU 9 41520020 RWRKREG1 EQU 14 S20201 41530020 RWRKREG2 EQU 15 41540020 SPACE 1 41550020 * **************** 41560020 * * HOUSEKEEPING * 41570020 * **************** 41580020 SPACE 2 41590020 WRTVTOC MVI DSCBSW,H01 ERROR WRITING DSCBS S20201 41600020 L RLINK9,ADR5E RESTORE TAB5E BASE REG. S20201 41610020 CLI UCBTO,T2301 IS DEVICE 2301 S20201 41620020 BNE SET2305 NO S20201 41630020 MVC BMPTK1+K1(K1),ORIGENDX+K3 YES,RESTORE LAST TRACK S20201 41640020 SET2305 TM FLGDRUM,H04 IS DEVICE 2305 S20201 41650020 BNO SETCNTRL NO S20201 41660020 MVI BMPTK1+K1,H00 YES, RESET LAST TRACK S20201 41670020 SPACE 1 41680020 SETCNTRL MVC HH+2(2),FALSEKD SET R OF CCHHR TO ZERO 41690020 SPACE 1 41700020 LA RBUPDATE,WRTDSCB PREPARE LOOP 41710020 SR RBCNTRL,RBCNTRL TO BUILD 41720020 IC RBCNTRL,DSCBPRTK CCWS 41730020 SLL RBCNTRL,4 AND 41740020 LA RSTOPB,WRTDSCB-16 COUNT 41750020 AR RSTOPB,RBCNTRL FIELDS 41760020 LA RBCNTRL,16 41770020 SPACE 1 41780020 LA RWRKREG1,CNTFIELD GET ADDRESS OF COUNT FIELD 41790020 O RWRKREG1,WCKDFLG AND PUT OPCODE FOR CCWS 41800020 SPACE 1 41810020 LA RWRKREG2,1 PREPARE TO WRITE "R" OF CCHHR 41820020 L RWRKREG3,VTOCEND GET VTOC TRACK EXTENT 41830020 L RWRKREG4,EXTNTAB+8 VTOC START ADR CCHH 41840020 ST RWRKREG4,DMMYCNTF STORE CCHH IN COUNT FIELD 41850020 ST RWRKREG4,CCHH STORE FOR SEARCH CCW 41860020 ST RWRKREG4,STRTADR+2 SAVE ADDRESS 41870020 SPACE 1 41880020 MVI VTOCSW,X'01' SET SWITCH TO TELL IF VTOC;DSCB 41890020 * HAS BEEN WRITTEN 41900020 SPACE 2 41910020 BLDLOOP MVC 0(16,RBUPDATE),DMMYCCW GET NEW SET OF CCWS 41920020 MVC 0(8,RWRKREG1),DMMYCNTF GET NEW COUNT 41930020 ST RWRKREG1,0(RBUPDATE) UPDATE ADDRESS OF CCW 41940020 STC RWRKREG2,4(RWRKREG1) UPDATE DSCB NUMBER 41950020 LA RWRKREG2,1(RWRKREG2) INCRIMENT DSCB NUMBER 41960020 AH RWRKREG1,EIGHTX INCREMENT CCW ADR FIELD 41970020 BXLE RBUPDATE,RBCNTRL,BLDLOOP LOOP UNTIL DONE, THEN WRITE 41980020 SPACE 1 41990020 SH RBUPDATE,EIGHTX TURN OFF 42000020 MVI 4(RBUPDATE),X'20' COMMAND-CHAIN FLAG 42010020 LA RBUPDATE,CNTFIELD PREPARE LOOP 42020020 LA RBCNTRL,8 TO 42030020 LA RSTOPB,CNTFIELD-8 MODIFY 42040020 SR RWRKREG1,RWRKREG1 42050020 IC RWRKREG1,DSCBPRTK 42060020 SLL RWRKREG1,3 42070020 AR RSTOPB,RWRKREG1 COUNT 42080020 SPACE 1 42090020 TM VTOCSW,X'01' HAVE VTOC AND DSCB BEEN READ 42100020 BZ WTDSCBTK YES 42110020 SPACE 1 42120020 SPACE 1 42130020 MVC WRTDSCB+25(3),ADSCB 42140020 SPACE 1 42150020 LA RVTOCADD,VTOCS GET ADDRESS OFVTOC FOR DEVICE 42160020 O RVTOCADD,WCKDFLG KEEP OPCODE 42170020 ST RVTOCADD,WRTDSCB+8 STORE IN PROPER CCW 42180020 SPACE 1 42190020 * DETERMINE NUMBER OF DSCBS REMAINING 42200020 SR RWRKREG5,RWRKREG5 CLEAR REGISTER 42210020 IC RWRKREG5,DSCBPRTK GET NUMBER OF DSCBS/TRACK/DASD 42220020 MH RWRKREG5,VTOCEND+2 MULT BY VTOC EXTENT 42230020 BCTR RWRKREG5,0 TWO ALREADY ASSIGNED 42240020 BCTR RWRKREG5,0 42250020 PROCEED1 STH RWRKREG5,50(RVTOCADD) STORE IN VTOC DSCB 42260020 SPACE 1 42270020 WTDSCBTK LA RUCBREG,UCBTO WRITE 42280020 LA RCCWREG,CCWLIST A TRACK 42290020 BAL RLINK9,STARTIO OF DUMMY DSCBS 42300020 L RLINK9,ADR5E RESTORE TAB5E BASE REG. S20201 42310020 SPACE 1 42320020 TM VTOCSW,X'01' WAS VTOC JUST WRITTEN 42330020 BO MODIFYX YES 42340020 SPACE 1 42350020 UPDTTRK BAL RLINK9,MODIFYX1 UPDATE TRACK S20201 42360020 L RLINK9,ADR5E RESTORE TAB5E BASE REG. S20201 42370020 ST RWRKREG4,CCHH STORE FOR SEARCH ADDRESS 42380020 LOOP3B ST RWRKREG4,0(RBUPDATE) MODIFY COUNT FIELD 42390020 BXLE RBUPDATE,RBCNTRL,LOOP3B LOOP UNTIL DONE 42400020 LA RBUPDATE,CNTFIELD REINITIALIZE COUNTFIELD 42410020 BCT RWRKREG3,WTDSCBTK WRITE TRACKS UNTIL DONE 42420020 B EOJ INITIATE EOJ S20201 42430020 SPACE 2 42440020 MODIFYX MVI VTOCSW,X'00' TURN OFF "WRITE VTOC" SWITCH 42450020 MVC WRTDSCB+8(4),DMMYCCW+8 CHANGE CCW LIST TO 42460020 MVC WRTDSCB+24(4),DMMYCCW+8 WRITE ONLY DUMMY DSCBS 42470020 B UPDTTRK AND RETURN 42480020 EJECT 42490020 * ****************** 42500020 * * DEVICE CONTROL * 42510020 * ****************** 42520020 SPACE 2 42530020 * FULL WORDS. 42540020 SAVEREGS DS 16F 42550020 WCKDFLG DC X'1D000000' 42560020 EIGHTX DC H'8' 42570020 DS 0D 42580020 DMMYCCW CCW X'1D',CNTFIELD,X'A0',8 42590020 CCW X'1D',FALSEKD,X'60',140 42600020 DMMYCNTF DS F 42610020 DC X'002C0060' 42620020 FALSEKD DC 35X'00000000' 42630020 CCWLIST DS 0D 42640020 SEEKCCW CCW 7,BBCCHH,X'60',6 42650020 SETMASK CCW X'1F',SETFMK,X'40',1 S20201 42660020 SEARCCW CCW X'31',CCHH,X'40',5 42670020 SEARTIC CCW 8,SEARCCW,X'60',150 42680020 CCW 8,WRTDSCB,X'40',1 TIC TO CHAIN OF WRT CKDS 42690020 PASSCTR DC D'0' NUMBER OF PASSES /TRACK. 42700020 ERRPASS DC F'0' SAVE COUNT DURING 10 RETRIES. 42710020 DEC255 DC H'255' COMPARE CONSTANT FOR PASSES. 42720020 EJECT 42730020 GETALTYZ BAL LINK15,CKVOLLBL GET NUMBER OF ALTERNATES 42740020 TM BINSW,X'03' WAS DEVICE 2321 AND BIN REQUEST 42750020 BM SCANERR NO - ERROR 42760020 MVI BINSW,X'00' YES - CLEAR SWITCH 42770020 TM FLGDRUM,H24 WAS IT 2305 AND MODEL S20201 42780020 BM SCANERR NO, ERROR S20201 42790020 CLI VOLCHKSW,X'FF' VOL CHECK BYPASS ON 42800020 BC 8,GETALTX YES - BYPASS VOL LABEL CHK 42810020 BAL LINK15,CKVOLLBL NO - CHECK VOLUME LABEL 42820020 MVI VOLCHKSW,X'FF' SET VOL LABEL CHK BYPASS 42830020 GETALTX MVC STRTADR+2(4),TRACKADR INSERT TRACK CCHH IN STRTADR 42840020 CLI BYPASS,X'FF' IS TRACK CHK BYPASS SW SET 42850020 BC 8,GETALT3 SET UP ALT TRACK ASSIGNMENT 42860020 CLI UCBTO,T3330 IS DEVICE 3330 S20201 42870020 BE GETALT3 YES, NO SURFACE ANALYSIS S20201 42880020 MVI SPIOSW,X'F0' SET TRACK CHECK SWITCH 42890020 L IOLOOP,PASSCTR SET FOR NUMBER OF PASSES. 42900020 B GEN5E GENERATE TRACK CHK DATA 42910020 GETALT3 MVI SPIOSW,X'00' CLEAR TRACK CHECK SWITCH 42920020 B ASGNALT 42930020 GETALT4 MVC CCHH(5),SAVALTCC GET VTOC ADR POINTER 42940020 LA UCBREG,UCBTO POINTER TO DASD UCB 42950020 LA CCWREG,UPVTOC CCW LIST POINTER 42960020 BAL LINK9,STARTIO ISSUE SIO 42970020 B ALTRTN RETURN TO GETALT ROUTINE 42980020 SPACE 2 42990020 GETALT2 MVC PRWD(43),GOODMSG PRINT TRACK GOOD MESSAGE. 43000020 LA CSR1,43 MESSAGE LENGTH IN BYTES. 43010020 BAL LINK9,PRNT INK TO MESSAGE PRINT ROUTINE 43020020 BAL LINK9,PRNT FORCE DOUBLE SPACE. 43030020 B ALTRTN RETURN - PROCESS NEXT STATEMENT 43040020 SPACE 1 43050020 ALTALT MVC SEEKADR+2(4),STRTADR+2 SET UP SEEK ADDRESS 43060020 BAL LINK14,GETHAR0 GET HOME ADDRESS AND R0 43070020 BAL LINK14,ASGNALTB FLAG THIS ALT BAD 43080020 L REG14,ADR5E RESTORE BASE REGISTER FOR TAB5E. 43090020 CLC VBUFFR0(4),TRACKADR WAS THIS ALT ASSIGNED 43100020 BE GETALT4 GO UPDATE THE VTOC. 43110020 MVC TRACKADR(4),VBUFFR0 GET ADDRESS OF ORIGINAL 43120020 B ORGBAD ASSIGN ALT TO IT 43130020 SPACE 1 43140020 GOODMSG DC C'IBC109I TRACK CHK INDICATES TRACK IS GOOD.' 43150020 SPACE 2 43160020 * CCW LIST FOR VTOC UPDATE 43170020 UPVTOC CCW X'07',BBCCHH,X'40',6 SEEK VTOC 43180020 CCW X'1F',SETFMK,X'40',1 SET FILE MASK S20201 43190020 SRCHVTOC CCW X'31',CCHH,X'40',5 SEARCH VTOC DSCB RECORD 43200020 CCW 8,SRCHVTOC,X'40',1 TIC 43210020 CCW 5,SAVEVTOC,X'20',96 WRITE VTOC DSCB UPDATED DATA 43220020 EJECT 43230020 * ALTERNATE TRACK ASSIGNMENT ROUTINE 43240020 * 43250020 * STRTADR CONTAINS CURRENT CCHH ON ENTRY TO ROUTINE 43260020 * ALTADR CONTAINS CURRENT ALTERNATE ADDRESSON ENTRY TO ROUTINE 43270020 * 43280020 ASGNALT MVC TRACKADR(4),STRTADR+2 SAVE ORIGINAL TRACK ADDRESS 43290020 CLC ALTCNTX(2),CLEAR ARE ALTERNATES DEPLETED 43300020 BE ALTERR YES, PRINT MESSAGE 43310020 CLI GTALTSW,X'FF' IS THIS A GET ALT FUNCTION 43320020 BC 8,ORGBAD YES - ASSIGN ALT TRACK 43330020 CLC STRTADR+2(4),CLEAR TRACK ZERO 43340020 BC 8,TRKZERO YES-PRINT MSG AND TERMINATE 43350020 ASGNALTC CLC STRTADR+2(4),ORIGENDX IS THIS AN ALTERNATE TRACK 43360020 BNH ORGBAD NO - THIS IS AN ORIGINAL 43370020 LH REGD,ALTCNTX GET REMAINING ALT COUNT S20201 43380020 BCTR REGD,R0 DECREMENT THE COUNT S20201 43390020 STH REGD,ALTCNTX RESTORE THE COUNT S20201 43400020 MVC SAVEVTOC+L12(L2),ALTCNTX MOVE ALT AVAIL TO VTOC S20201 43410020 SPACE 1 43420020 ASGNALTB MVI STRTADR+1,X'03' SET FLAG - ALT BAD 43430020 TM ERR906SW,X'01' BAD HA OR R0 IN 2321 43440020 BZ ASGNALTD NO 43450020 MVI ERR906SW,X'00' RESET BAD HA-R0 SWITCH. 43460020 OI STRTADR+1,X'40' YES, SET IN 800 BYTES 43470020 ASGNALTD LA UCBREG,UCBTO POINTER TO DASD UCB 43480020 LA CCWREG,WRTALT POINTER TO CCW LIST 43490020 BAL LINK9,STARTIO ISSUE SIO SEQUENCE 43500020 BAL LINK15,TRKPRNT1 PRINT MESSAGE TELLING BAD TRACK 43510020 MVI STRTADR+1,X'01' RESET -GOOD ALT - FLAG 43520020 CLI GTALTSW,X'FF' WAS THIS GET ALT FOR ALT 43530020 BCR 8,LINK14 YES, RETURN 43540020 CLI UCBTO,T2321 IS DEVICE 2321 S20201 43550020 BE MALTRTN YES, RETURN 43560020 BAL LINK9,MODIFYXZ INCRIMENT TRACK ADDRESS 43570020 B INTALTR RETURN 43580020 EJECT 43590020 * FORMAT THE ALTERNATE TRACK 43600020 SPACE 2 43610020 ORGBAD CLC TRACKADR(4),ORIGENDX IS THIS GET ALT FOR ALT 43620020 BH ALTALT YES, GO TO SPECIAL ROUTINE 43630020 MVC SEEKADR+2(4),ALTHOLD ENTER ADDRESS OF ALT TRK 43640020 MVC STRTADR+2(4),ALTHOLD ENTER ADDRESS OF ALTERNATE TRK 43650020 BAL LINK14,GETHAR0 GET ALT'S HA AND R0 43660020 L REG14,ADR5E RESTORE BASE REGISTER FOR TAB5E. 43670020 CLI HABUFR,X'03' WAS THIS A BAD ALTERNATE 43680020 BNE AROUNDGT NO 43690020 BAL LINK9,MODIFYXZ INCRIMENT IT 43700020 ST REGG,ALTHOLD STORE IT 43710020 B ORGBAD 43720020 SPACE 1 43730020 AROUNDGT MVI STRTADR+1,X'01' SET FLAG BIT ALT ASG 43740020 MVC ROCOUNT(4),TRACKADR ENTER ORG TRACK ADR IN RO 43750020 LA UCBREG,UCBTO POINTER TO DASD UCB 43760020 LA CCWREG,WRTALT POINTER TO CCW LIST 43770020 BAL LINK9,STARTIO ISSUE SIO SEQUENCE 43780020 SPACE 1 43790020 * FORMAT ORIGINAL TRACK BAD 43800020 SPACE 1 43810020 FZEUS MVC SEEKADR+L2(L4),TRACKADR ENTER ADDR OF ORIG. TRK S20201 43820020 MVC STRTADR+2(4),TRACKADR ENTER ADDRESS OF ORIGINAL TRACK 43830020 MVI STRTADR+1,X'02' SET FLAG ORIGINAL BAD 43840020 MVC ROCOUNT(4),ALTHOLD STORE ALTERNATE ADDRESS IN R0 43850020 TM ERR906SW,X'01' BAD HA OR R0 IN IOIU 43860020 BZ ORGBADA NO 43870020 MVI ERR906SW,X'00' RESET BAD HA-R0 SWITCH. 43880020 OI STRTADR+1,X'40' YES, SET IN 800 BYTES 43890020 ORGBADA LA UCBREG,UCBTO POINTER TO DASD UCB 43900020 LA CCWREG,WRTALT POINTER TO CCW LIST 43930020 BAL LINK9,STARTIO ISSUE SIO SEQUENCE 43940020 BAL LINK15,TRKPRNT PRINT BAD TRACK MSG 43970020 LH REGD,ALTCNTX DECRIMENT 43980020 BCTR REGD,0 ALT AVAILABLE 43990020 STH REGD,ALTCNTX COUNT 44000020 MVC STRTADR+2(4),ALTHOLD 44010020 BAL LINK9,MODIFYX1 INCRIMENT "NEXTALT" ADDRESS 44020020 ST REGG,ALTHOLD AND SAVE IT 44030020 MVC STRTADR+2(4),TRACKADR RESTORE ORIGINAL ADDRESS 44040020 MVC SAVEVTOC+8(6),ALTHOLD SAVE THE UST ALT AND COUNT 44050020 TM FLGDRUM,H04 IS DEVICE A 2305 S20201 44060020 BNO ORGBAD1 NO S20201 44070020 MVI SAVEVTOC+L11,H00 RESTORE LAST ALT. ADDR S20201 44080020 ORGBAD1 CLI GTALTSW,X'FF' IS THIS A GET ALT REQUEST 44090020 BC 8,GETALT4 YES - RETURN TO GETALT ROUTINE 44100020 CLI UCBTO,T2321 IS DEVICE 2321 S20201 44110020 BE MALTRTN YES, RETURN 44120020 BAL LINK9,MODIFYXZ INCRIMENT TRACK ADDRESS 44130020 B SEEK RETURN 44140020 GETHAR0 LA CCWREG,SEEKIPLX POINTER TO CCW LIST 44150020 LA UCBREG,UCBTO POINTER TO DASD UCB 44160020 BAL LINK9,STARTIO ISSUE SIO SEQUENCE 44170020 BR LINK14 RETURN 44180020 EJECT 44190020 TRACKBAD BAL LINK15,TRKPRNT1 IDENTIFY THE LAST BAD TRACK. 44200020 MVC PRWD(28),HAROMSG SET UP BAD HA-R0 MESSAGE. 44210020 MVC PRWD+28(17),JOBTERM INSERT JOB TERMINATED MESSAGE. 44220020 LA CSR1,44 MESSAGE LENGTH IN BYTES. 44230020 BAL LINK9,PRNT 44240020 LPSW COWAIT SET ERROR WAIT STATE 44250020 SPACE 1 44260020 HAROMSG DC C'IBC108A HA OR RO FIELD BAD.' 44270020 SPACE 1 44280020 JOBTERM DC C' JOB TERMINATED.' 44290020 SPACE 2 44300020 ALTERR BAL LINK15,TRKPRNT1 IDENTIFY THE LAST BAD TRACK. 44310020 MVC PRWD(29),ALTMSG INSERT ALT TRACKS DEPLETED MSG. 44320020 MVC PRWD+29(17),JOBTERM INSERT JOB TERMINATED MSG. 44330020 LA CSR1,45 MESSAGE LENGTH IN BYTES. 44340020 BAL LINK9,PRNT LINK TO PRNT ROUTINE 44350020 LPSW COWAIT SET ERROR TERMINATE 44360020 SPACE 1 44370020 ALTMSG DC C'IBC112W ALT TRACKS DEPLETED.' 44380020 SPACE 2 44390020 TRKZERO LA CSR1,40 LENGTH OF MESSAGE 44400020 MVC PRWD(24),ZEROMSG INSERT TRACK ZERO BAD MESSAGE 44410020 CLI IPLSW,X'00' IPL REQUESTED 44420020 BNE ZEROTERM YES, TERMINATE 44430020 BAL LINK9,PRNT NO, PRINT MESSAGE 44440020 B ASGNALTC RETURN TO FINISH JOB. 44450020 ZEROTERM MVC PRWD+24(17),JOBTERM INSERT JOB TERMINATED MESSAGE 44460020 BAL LINK9,PRNT 44470020 LPSW COWAIT SET ERROR WAIT STATE 44480020 SPACE 1 44490020 ZEROMSG DC C'IBC107W TRACK ZERO BAD.' 44500020 EJECT 44510020 * THE FOLLOWING ROUTINE PRINTS A BAD TRACK 44520020 * MESSAGE DEPENDING ON THE DASD TYPE 44530020 TRKPRNT1 MVI ALTALTSW,X'01' GET ALT FOR ALT (NONE ASSIGNED) 44540020 TRKPRNT STM 0,15,REGSV8 SAVE REGISTERS 44550020 MVI STRTADR+1,X'00' CLEAR BAD TRACK FLAG BITS 44560020 MVC PRWD(18),BAD INSERT BAD TRACK MESSAGE 44570020 UNPK PRWD+20(9),STRTADR+2(5) INSERT ORIGINAL TRACK ADDRESS 44580020 BAL LINK9,FINSPRNT FINISH 44590020 SPACE 1 44600020 MVC PRWD(18),ALT INSERT ALTERNATE MESSAGE 44610020 CLI ALTALTSW,X'01' IS THIS GET ALT; ALT 44620020 MVI ALTALTSW,X'00' CLEAR SWITCH 44630020 BE FINSPTA YES, PRINT BLANKS 44640020 UNPK PRWD+20(9),ALTHOLD(5) INSERT ALTERNATE TRACK ADDRESS 44650020 BAL LINK9,FINSPRNT FINISH 44660020 SPACE 1 44670020 FINSPTB BAL LINK9,PRNT FORCE DOUBLE SPACE 44680020 LM 0,15,REGSV8 RESTORE REGISTERS 44690020 BR LINK15 RETURN TO CALLER 44700020 SPACE 1 44710020 FINSPRNT TR PRWD+20(8),CCTRTAB-240 CONVERT TO PRINTABLE FORMAT 44720020 MVI PRWD+28,C' ' CLEAR UNPK GARBAGE 44730020 LA REG1,30 44740020 B PRNT 44750020 SPACE 1 44760020 FINSPTA MVC PRWD+20(4),NONE NO 44770020 LA REG1,30 ALTS 44780020 BAL LINK9,PRNT ASSIGNED 44790020 B FINSPTB 44800020 SPACE 1 44810020 NONE DC C'NONE' 44820020 EJECT 44830020 * IPL RECORD ONE CONTENTS 44840020 * 44850020 DS 0D 44860020 IPLPRES DC A(0) COUNT CCHH 44870020 DC X'01' RECORD NUMBER 44880020 DC X'04' KEY LENGTH 44890020 DC AL2(24) DATA LENGTH 44900020 DC C'IPL1' KEY 44910020 DC XL8'00' DATA PSW 1 44920020 DC X'06' CCW1 READ COMMAND 44930020 DC AL3(15000) DATA ADDRESS 44940020 DC X'60' CC, SILI 44950020 DC X'00' FLAGS 44960020 DC AL2(96) COUNT 44970020 DC X'08' CCW2 TIC 44980020 DC AL3(15000) TRANSFER ADDRESS 44990020 DC A(0) FLAGS AND COUNT 45000020 * 45010020 * IPL RECORD ONE (IPL NOT REQUESTED) 45020020 * 45030020 DS 0D 45040020 IPLABST DC A(0) COUNT CCHH 45050020 DC X'01' RECORD NUMBER 45060020 DC X'04' KEY LENGTH 45070020 DC AL2(24) DATA LENGTH 45080020 DC C'IPL1' KEY 45090020 DC X'00' IPL PSW SYSTEM MASK--DISABLED 45100020 DC X'060000' MACHINE CHECK-WAIT STATE 45110020 DC X'0000000F' NO IPL RESIDENCE INDICATOR 45120020 DC X'03' CCW1 NOP BREAKS THE CHAIN 45130020 DC XL7'01' COUNT OF ONE 45140020 DC XL8'00' CCW2 DUMMY CCW 45150020 SPACE 2 45160020 * VOLUME LABEL MAKE-UP AREA 45170020 * 45180020 WRTSYLAB DC A(0) COUNT CCHH 45190020 DC X'03' RECORD THREE 45200020 DC X'04' KEY LENGTH 45210020 DC AL2(80) DATA LENGTH 45220020 DC C'VOL1' KEY FIELD 45230020 * 45240020 VOLABID DC C'VOL' INDICATE DASD VOLUME LABEL 45250020 VOLSEQNO DC C'1' VOLUME SEQUENCE NO ASSUMED 1 45260020 VOLSERNO DC 6C' ' VOLUME SERIAL NUMBER 45270020 VOLSECNO DC X'F0' SECURITY NUMBER (ASSUMED ZERO) 45280020 VOLDSETD DC 10C' ' VTOC POINTER (INSERTED) S20201 45290020 DC 10C' ' MANUFACTOR NUMBER 45300020 DC 10C' ' ASA NUMBER 45310020 VOWNERID DC XL10'00' OWNER ID. (ASSUMED ZERO) 45320020 VOLUNUSE DC 29C' ' UNUSED (BLANKS) 45330020 DC A(24) 45340020 BUFFER DS 1F 45350020 * USER LABEL DUMMY AREAS 45360020 * 45370020 USERLAB1 DC A(0) COUNT CCHH 45380020 DC X'04' RECORD FOUR 45390020 DC X'04' KEY LENGTH 45400020 DC AL2(80) DATA LENGTH 45410020 DC C'VOL2' KEY FIELD 45420020 DC C'VOL2' DATA FIELD AS5695 45422000 DC XL76'00' DATA FIELD 45430000 USERLAB2 DC A(0) COUNT CCHH 45440020 DC X'05' RECORD FIVE 45450020 DC X'04' KEY LENGTH 45460020 DC AL2(80) DATA LENGTH 45470020 DC C'VOL3' KEY FIELD 45480020 DC C'VOL3' DATA FIELD AS5695 45482000 DC XL76'00' DATA FIELD 45490000 USERLAB3 DC A(0) COUNT CCHH 45500020 DC X'06' RECORD SIX 45510020 DC X'04' KEY LENGTH 45520020 DC AL2(80) DATA LENGTH 45530020 DC C'VOL4' KEY FIELD 45540020 DC C'VOL4' DATA FIELD AS5695 45542000 DC XL76'00' DATA FIELD 45550000 USERLAB4 DC A(0) COUNT CCHH 45560020 DC X'07' RECORD SEVEN 45570020 DC X'04' KEY LENGTH 45580020 DC AL2(80) DATA LENGTH 45590020 DC C'VOL5' KEY FIELD 45600020 DC C'VOL5' DATA FIELD AS5695 45602000 DC XL76'00' DATA FIELD 45610000 USERLAB5 DC A(0) COUNT CCHH 45620020 DC X'08' RECORD EIGTH 45630020 DC X'04' KEY LENGTH 45640020 DC AL2(80) DATA LENGTH 45650020 DC C'VOL6' KEY FIELD 45660020 DC C'VOL6' DATA FIELD AS5695 45662000 DC XL76'00' DATA FIELD 45670000 USERLAB6 DC A(0) COUNT CCHH 45680020 DC X'09' RECORD NINE 45690020 DC X'04' KEY LENGTH 45700020 DC AL2(80) DATA LENGTH 45710020 DC C'VOL7' KEY FIELD 45720020 DC C'VOL7' DATA FIELD AS5695 45722000 DC XL76'00' DATA FIELD 45730000 USERLAB7 DC A(0) COUNT CCHH 45740020 DC AL1(10) RECORD TEN 45750020 DC X'04' KEY LENGTH 45760020 DC AL2(80) DATA LENGTH 45770020 DC C'VOL8' KEY FIELD 45780020 DC C'VOL8' DATA FIELD AS5695 45782000 DC XL76'00' DATA FIELD 45790000 * 45800020 * DADSM DSCB'S 45810020 SPACE 2 45820020 * DADSM DSCB FOR 2311 45830020 * 45840020 DSCBS DS 0D 45850020 DC X'05050505' KEY FIELD 45860020 DC X'0000' RELATIVE START ADR 45870020 DC XL2'0' NUMBER OF UNUSED CYLINDERS 45880020 DC X'00' ODD TRACKS REMAINING 45890020 DC XL35'00' AVAILABLE EXTENTS IN KEY 45900020 DC X'F5' FORMAT ID 45910020 DC XL95'00' DATA FIELD UNUSED 45920020 EJECT 45930020 SPACE 6 45940020 *********************************************************************** 45950020 *********************************************************************** 45960020 ** ** 45970020 ** CCW LIST VARIATIONS FOR DISK AND DRUM INITIALIZATION. ** 45980020 ** ** 45990020 *************** *************** 46000020 ** ** 46010020 ** . SA-FORMAT W/FT . ANALYSIS W/FT . FORMAT ONLY ** 46020020 ** ADDRESS . DISKS ONLY . DISKS ONLY . DISKS ONLY ** 46030020 ** . PASS CNT=1 . PASS COUNT . ** 46040020 ** . . GREATER 1 . ** 46050020 **...................................................................** 46060020 ** . . . ** 46070020 ** WRITE5E . SEEK . SEEK . SEEK ** 46080020 ** . SET FILE MASK . SET FILE MASK . SET FILE MASK ** 46090020 ** SRCHHA1 . SEARCH HA . SEARCH HA . SEARCH HA ** 46100020 ** TICSCH . TIC *-8 . TIC *-8 . TIC *-8 ** 46110020 ** FIVEER0 . WRT R0 (MAX) . WRT R0 (MAX) . TIC (XXXR0) ** 46120020 ** . RD HA (SKIP) . RD HA (SKIP) . ** 46130020 ** FIVEER01. RD R0 (SKIP) . RD R0 (SKIP) . ** 46140020 ** SRCHHA2 . SEARCH HA . SEARCH HA . ** 46150020 ** . TIC *-8 . TIC *-8 . ** 46160020 ** ONE3R0 . WRT R0 (MAX) . WRT R0 (MAX) . ** 46170020 ** . RD HA (SKIP) . RD HA (SKIP) . ** 46180020 ** READRO . RD R0 (SKIP) . RD R0 (SKIP) . ** 46190020 ** SRCHHA3 . SEARCH HA . RD HA . ** 46200020 ** . TIC *-8 . . ** 46210020 ** . TIC (XXXR0) . . ** 46220020 ** . . . ** 46230020 ** XXXR0 . WRT R0 (STD) . . WRT R0 (STD) ** 46240020 ** XXXHA . RD HA . . RD HA ** 46250020 ** . RD R0 (SKIP) . . RD R0 (SKIP) ** 46260020 ** . . . ** 46270020 *************** . . *************** 46280020 ** . . ** 46290020 EJECT ** 46300020 SPACE 6 46310020 ** ** 46320020 *************** *************** 46330020 ** ** 46340020 ** . SA-FORMAT W/O FT . ANALYSIS W/O FT . FORMAT ONLY ** 46350020 ** ADDRESS . DRUMS-DISK OPT . DRUMS-DISK OPT . DRUMS ** 46360020 ** . PASS CNT=1 . PASS COUNT . ** 46370020 ** . . GREATER 1 . ** 46380020 **...................................................................** 46390020 ** . . . ** 46400020 ** WRITE5E . SEEK . SEEK . SEEK ** 46410020 ** . SET FILE MASK . SET FILE MASK . SET FILE MASK ** 46420020 ** SRCHHA1 . WRT HA . WRT HA . WRT HA ** 46430020 ** TICSCH . TIC *+8 . TIC *+8 . TIC (XXXR0) ** 46440020 ** FIVEER0 . WRT R0 (MAX) . WRT R0 (MAX) . ** 46450020 ** . RD HA (SKIP) . RD HA (SKIP) . ** 46460020 ** FIVEER01. RD R0 (SKIP) . RD R0 (SKIP) . ** 46470020 ** SRCHHA2 . SEARCH HA . SEARCH HA . ** 46480020 ** . TIC *-8 . TIC *-8 . ** 46490020 ** ONE3R0 . WRT R0 (MAX) . WRT R0 (MAX) . ** 46500020 ** . RD HA (SKIP) . RD HA (SKIP) . ** 46510020 ** READRO . RD R0 (SKIP) . RD R0 (SKIP) . ** 46520020 ** SRCHHA3 . SEARCH HA . RD HA . ** 46530020 ** . TIC *-8 . . ** 46540020 ** . TIC (XXR0) . . ** 46550020 ** . . . ** 46560020 ** XXXR0 . WRT R0 (STD) . . WRT R0 (STD) ** 46570020 ** XXXHA . RD HA . . RD HA ** 46580020 ** . RD R0 (SKIP) . . RD R0 (SKIP) ** 46590020 ** . . . ** 46600020 ** . . . ** 46610020 *********************************************************************** 46620020 *********************************************************************** 46630020 EJECT 46640020 SPACE 6 46650020 *********************************************************************** 46660020 *********************************************************************** 46670020 ** ** 46680020 ** CCW LIST VARIATIONS FOR 3330 INITIALIZATION ** 46690020 ** ** 46700020 ************** *************** 46710020 ** . . ** 46720020 ** . . ** 46730020 ** ADDRESS . 3330 ONLY . ** 46740020 ** . . ** 46750020 ** . . ** 46760020 ** . . ** 46770020 **...................................................................** 46780020 ** . . ** 46790020 ** SEEKIPLX . SEEK . ** 46800020 ** . SET FILE MASK . ** 46810020 ** . READ HA . ** 46820020 ** . READ R0 (STD) . ** 46830020 ** . . ** 46840020 ** . . ** 46850020 ** . . ** 46860020 ** . . ** 46870020 ** . . ** 46880020 ** . . ** 46890020 ** . . ** 46900020 ** . . ** 46910020 ** . . ** 46920020 ** . . ** 46930020 ** . . ** 46940020 ** . . ** 46950020 ** . . ** 46960020 ** . . ** 46970020 ** . . ** 46980020 ** . . ** 46990020 *********************************************************************** 47000020 *********************************************************************** 47010020 EJECT 47020020 *********************************************************************** 47030020 * * 47040020 * CCW LIST FOR SURFACE ANALYSIS/FORMATTING--DISKS AND DRUMS ONLY. * 47050020 * * 47060020 *********************************************************************** 47070020 SPACE 1 47080020 WRITE5E CCW 7,SEEKADR,X'40',6 SEEK. 47090020 CCW X'1F',SETFMK,X'40',1 SET FILE MASK. 47100020 SRCHHA1 CCW X'39',STRTADR+2,X'40',4 SEARCH HA OR WRITE HA. 47110020 TICSCH CCW 8,SRCHHA1,0,0 REPEAT UNTIL FOUND OR TIC NEXT. 47120020 FIVEER0 CCW X'15',TAB5E,X'60',3625 WRITE MAXIMUM R0 RECORD. 47130020 CCW X'1A',BUFFER,X'70',5 VERIFY THE HOME ADDRESS. 47140020 FIVEER01 CCW X'16',BUFFER,X'70',3660 VERIFY R0. 47150020 SRCHHA2 CCW X'39',STRTADR+2,X'40',4 SEARCH HA. 47160020 CCW 8,SRCHHA2,0,0 REPEAT UNTIL FOUND. 47170020 ONE3R0 CCW X'15',TAB13,X'60',3625 WRITE MAXIMUM R0 RECORD. 47180020 CCW X'1A',BUFFER,X'70',5 VERIFY HA. 47190020 READRO CCW X'16',BUFFER,X'70',3625 VERIFY R0. 47200020 SRCHHA3 CCW X'39',STRTADR+2,X'40',4 SEARCH HA. 47210020 CCW 8,SRCHHA3,0,0 REPEAT UNTIL FOUND. 47220020 CCW 8,XXXR0,0,0 GO WRITE STANDARD R0. 47230020 SPACE 1 47240020 *********************************************************************** 47250020 * * 47260020 * CCW LIST USED FOR ASSIGNING ALTERNATE TRACKS. * 47270020 * THIS LIST IS ALSO USED FOR WRITING A STANDARD R0, READING INTO * 47280020 * CORE THE HOME ADDRESS, AND VERIFYING RECORD ZERO. * 47290020 * * 47300020 *********************************************************************** 47310020 SPACE 1 47320020 WRTALT CCW 7,SEEKADR,X'40',6 SEEK. 47330020 SPARZEUS CCW X'1F',SETFMK,X'40',1 SET FILE MASK S20201 47340020 CCW X'19',STRTADR+1,X'40',5 WRITE HOME ADDRESS. 47350020 XXXR0 CCW X'15',ROCOUNT,X'40',16 WRITE STANDARD R0. 47360020 XXXHA CCW X'1A',FLAG,X'40',5 VERIFY AND READ IN HA. 47370020 CCW X'16',ROCOUNT,X'30',16 VERIFY R0. 47380020 SPACE 1 47390020 * CCW LIST FOR WRITING R1 TO R11 47400020 * 47410020 DS 0D 47420020 WRTZERTR CCW 7,SEEKADR,X'40',6 SEEK TRACK ZERO 47430020 CCW X'1F',SETFMK,X'40',1 47440020 SEARCHRO CCW X'31',STRTADR,X'40',5 47450020 CCW 8,SEARCHRO,X'40',1 47460020 IPLNOCHG CCW X'1D',IPLPRES,X'40',36 R1(IPL1) 47470020 CCW X'1D',STRTREAD,X'40',156 R2 (IPL2) 47480020 WRTVOLAB CCW X'1D',WRTSYLAB,X'40',92 R3 (SYSTEM VOLUME LABEL) 47490020 LABELS CCW X'1D',USERLAB1,X'40',92 R4 (USER LABEL 1) 47500020 CCW X'1D',USERLAB2,X'40',92 R5 (USER LABEL 2) 47510020 CCW X'1D',USERLAB3,X'40',92 R6 (USER LABEL 3) 47520020 CCW X'1D',USERLAB4,X'40',92 R7 (USER LABEL 4) 47530020 CCW X'1D',USERLAB5,X'40',92 R8 (USER LABEL 5) 47540020 CCW X'1D',USERLAB6,X'40',92 R9 (USER LABEL 6) 47550020 CCW X'1D',USERLAB7,X'40',92 R10(USER LABEL 7) 47560020 TIC2301 CCW 8,IPLTRK0,X'40',1 47570020 SPACE 1 47580020 *CCW LIST FOR WRITING IPL INITIALIZATINO PROGRAM 47590020 SPACE 1 47600020 IPLSEEK CCW 7,SEEKIPL,X'40',6 SEEK IPL TRACK 47610020 CCW X'1F',SETFMK,X'40',1 SET FILE MASK 47620020 IPLSRCH CCW X'31',SEEKIPL+2,X'40',5 SEARCH R0 EQUAL 47630020 CCW 8,IPLSRCH,X'40',1 47640020 IPLTRK0 CCW X'1D',IPLADR,X'A0',8 WRITE IPL COUNT 47650020 CCW X'1D',X'007000',X'20',6496 WRITE IPL DATA 47660002 SPACE 2 47670020 IPLADR DC X'0000000101001960' 47680002 IPLCORE DC X'00007000' 47690020 SPACE 2 47700020 * RECORD TWO BOOTSTRAP CONTENTS 47710020 SPACE 1 47720020 DS 0D 47730020 DC F'0' 47740020 STRTREAD DC X'0000000002' COUNT 47750020 DC X'040090' FIELD 47760020 DC C'IPL2' KEY 47770020 * DATA 47780020 CCW X'07',15032,X'40',6 SEEK IPL TRACK 47790020 CCW X'31',15038,X'40',5 SEARCH IPL INIT RCD 47800020 CCW X'08',15008,X'00',1 TIC TO SEARCH CMD 47810020 CCW 6,0,X'20',6496 READ IPL INIT DATA 47820002 SPACE 1 47830020 SEEKIPL DC X'000000000001' IPL INIT TRACK ADR 47840020 SRCHADR DC X'0000000101' R1 ADR OF IPL INIT TRACK 47850020 DC XL101'00' PAD OUT IPL BS RCD WITH ZEROS 47860020 FLAG DC 5X'00' READ IN THE HOME ADDRESS HERE. 47870020 SPACE 2 47880020 W5E CCW X'15',TAB5E,X'60',3625 SURFACE ANALYSIS REQUESTED 47890020 TICWR0 CCW 8,XXXR0,X'60',1 NO SURFACE ANALYSIS REQUESTED 47900020 NOFLAG CCW X'19',STRTADR+1,X'40',5 WRITE HOME ADDRESS. 47910020 CCW 8,FIVEER0,0,0 USED WHEN FLAGTEST=NO. 47920020 SPACE 1 47930020 ERRSEEK CCW 7,SEEKADR,X'40',6 TRACK IN ERROR DURING ANALYSIS. 47940020 CCW X'1A',BUFFER,X'70',5 READ VERIFY THE HA. 47950020 ERRSEEK1 CCW X'16',BUFFER,X'30',3625 READ VERIFY RECORD 0. 47960020 EJECT 47970020 * TABLES AND CONSTANTS 47980020 * 47990020 ACTRACON DS 1F COMPUTED ACTUAL ADDRESS 48000020 AIPLABST DC A(IPLABST) WAIT STATE PSW - NO IPL REQUEST 48010020 AIPLPRES DC A(IPLPRES) LOAD & GO PSW - IPL REQUESTED 48020020 DS 0D 48030020 DC H'0' 48040020 STRTADR DC 3H'0' CONTAINS CURRENT CCHH VALUE 48050020 ROMAX DC XL8'00' USED BY SURFACE CHK 48060020 * COUNT FIELD IS MODIFIED/ DASD 48070020 ROCOUNT DC XL8'08' RO COUNT FIELD CCHHRKLDLDL 48080020 RODATA DC XL8'0' RO DATA - 8 BYTES ZERO 48090020 DC H'0' 48100020 SEEKADR DC 3H'0' CONTAINS UPDATED SEEK ADDRESS 48110020 DS 0F 48120020 SAVSPACE DC X'00' SAVE AREA FOR NO. OF USER LABELS 48130020 SPACE 2 48140020 *THE FOLLOWING HAVE NO BOUNDARY REQUIREMENTS 48150020 *VARIOUS CONSTANTS 48160020 SETFMK DC X'C0' 48170020 INCR1 DC X'C1' 3330 FILE MASK (NO RETRY) S20201 48180020 INCR2 DC X'C2' 2305 FILE MASK (NO RETRY) S20201 48190020 SAVEFMK DC X'C0' FILE MASK RESTORE FORMAT S20201 48200020 BAD DC C'IBC110I BAD TRACK' 48210020 ALT DC C'IBC111I ALTERNATE' 48220020 CCTRTAB DC C'0123456789ABCDEF' CONVERT TO PRINTABLE FORMAT 48230020 SCRATCH DC C'SCRATCH' 48240020 * 48250020 VTOCHCK DC X'00' USER SUPPLIED VTOC LOCATION IND. 48260020 CHAINSAV DS 1D SAVE CHAIN CONTENTS FOR TRACK 0 48270020 * STANDARD VTOC DSCB'S 48280020 VTOCS DS 0D 48290020 DC 44X'04' KEY FIELD 48300020 * VTOC DSCB DATA 48310020 DC C'4' FORMAT ID 48320020 VTOC1 DC XL5'0' CCHHR FIRST AVAILABLE FORMAT 1 48330020 DC XL2'0' DSCB'S REMAINING 48340020 VTOC2 DC X'00CA0009' HIGHEST CCHH OF ALT TRACKS 48350020 DC H'30' 48360020 DC X'00' VTOC INDICATOR 48370020 DC X'01001E' EXTENTS, NON USABLE TRACKS. 48380020 VTOC3 DC X'00CB000A0E29' DEVICE SIZE TRACK LENGTH 48390020 DC X'523714' RECORD OVERHEAD INFO 48400020 DC X'010219100A' FLAGS-TOLERANCE-DSCB-DIRECTOR 48410020 DC XL29'00' SPARE 48420020 DC X'0100' 48430020 VTOC4 DC XL4'0' VTOC START CCHH 48440020 DC XL4'0' VTOC END CCHH 48450020 DC XL25'00' SPARE 48460020 EJECT 48470020 * 48480020 * ROUTINE FORMATS THE TOTAL VTOC 48490020 * 48500020 * ROUTINE TO INSERT VTOC EXTENTS 48510020 * 48520020 FMTVTOC DS 0F 48530020 VTOCXTN STM 0,15,REGSV8 SAVE REGISTERS 48540020 MVC VTOC1(4),EXTNTAB+8 INSERT CCHH OF VTOC 48550020 MVI VTOC1+4,X'03' INSERT R OF ITS FORMAT 1 48560020 MVC VTOC2(6),SAVEVTOC+8 STORE FIRST ALT & COUNT 48570020 MVC VTOC3(14),DEVSIZEX INSERT DEVICE SIZE ETC. 48580020 MVC VTOC4(8),EXTNTAB+8 INSERT VTOC EXTENTS IN VTOC 48590020 MVC VTOC2+8(2),ORIGENDX+4 DADSM EXTENT. 48600020 * 48610020 * ROUTINE CALCULATES AND INSERTS EXTENTS IN DADSM DSCB 48620020 * 48630020 LA REGE,EXTNTAB GET ADR OF EXTNT TABLE 48640020 LA REGD,DSCBS POSITION TO DADSM EXTENT FIELDS 48650020 EXTNT2 MVC CCHHB(4),4(REGE) GET BGN ADR OF DATA SET 48660020 MVC CCHHE(4),8(REGE) GET END ADR OF DATA SET 48670020 CLC CCHHB(4),ORIGENDX HAVE ALL DATA SETS BEEN CHECKED 48680020 BNL EXTNT4 YES, RETURN TO WRITE VTOC 48690020 CLC CCHHE(4),CCHHB IS THERE ALLOCATABLE SPACE 48700020 BC 8,EXTNT3 NO - GET NEXT DATA SET 48710020 BAL LINK15,GETXXYYZ CONVERT TO XXYYZ FORMAT 48720020 MVC 4(5,REGD),XXYYZ INSERT EXTENT IN DADSM DSCB 48730020 LA REGD,5(REGD) POINT TO NEXT EXTENT FIELD 48740020 EXTNT3 LA REGE,8(REGE) POINT TO NEXT DATA SET 48750020 B EXTNT2 RETURN TO PROCESS DATA SET 48760020 EXTNT4 LM 0,15,REGSV8 RESTORE REGISTERS 48770020 CLI UCBTO,T2321 THIS A 2321 DEVICE S20201 48780020 BC 7,WRTVTOC NO--GO WRITE VTOC. 48790020 MVI CNGCYLX+2,X'00' YES - RESTORE UPDATE TRK FACTOR 48800020 B WRTVTOC PROCEED TO WRITE VTOC 48810020 * 48820020 * CONVERSION ROUTINE CCHH TO XXYYZ FORMAT 48830020 * 48840020 GETXXYYZ STM 0,15,SAVEREGS 48850020 CLI UCBTO,T2321 THIS A 2321 DEVICE S20201 48860020 BC 8,SETCCMF YES-GO CONVERT CYLINDER/TRACK. 48870020 CLI UCBTO,T2301 THIS A 2301 DEVICE S20201 48880020 BC 8,SETCC YES-GO SET UP TRACK ADDRESSES. 48890020 SPACE 1 48900020 GETXX1 L RWRKREG3,CCHHB SET UP FOR REGISTER MANIPULATN 48910020 CLC CCHHB+K3(K1),BMPTK+K1 NEED TO CHANGE CYLINDERS S20201 48920020 BE CNGCYLAA YES 48930020 A RWRKREG3,F1 NO, INCRIMENT TRACK ADDRESS 48940020 SPACE 1 48950020 GO1 ST RWRKREG3,CCHHB 48960020 L RWRKREG1,CCHHE GET TRUE CCHHE 48970020 SPACE 1 48980020 CLC CCHHB+2(2),CLEAR DOES BEGIN ADDRESS REPRESENT 48990020 * FULL CYLINDER 49000020 BE UNUSUAL YES 49010020 SPACE 1 49020020 CLR RWRKREG1,RWRKREG3 IS BEGIN = END 49030020 BE RTURNX YES, NO SPACE; RETURN 49040020 SPACE 1 49050020 CLC CCHHE(2),CCHHB IS BEG AND END ON SAME CYL 49060020 BE UNUSUAL YES 49070020 SPACE 1 49080020 * CYL/HEAD = CCE-CCB-1;HHE+10-HHB 49090020 AL RWRKREG1,M1PTRK CYL - 1; HEAD + XX 49100020 SPACE 1 49110020 UNUSUAL SR RWRKREG1,RWRKREG3 - (CCB; HHB) 49120020 STC RWRKREG1,XXYYZ+4 STORE NUMBER OF ODD TRACKS 49130020 SRL RWRKREG1,16 STORE NUMBER 49140020 STH RWRKREG1,XXYYZ+2 OF FULL CYLINDERS 49150020 BAL RLINK9,CNVRTRTA GO CONVERT BEG TO RTA 49160020 SPACE 1 49170020 STH RWRKREG4,XXYYZ STORE BEGINNING (RTA) S20201 49180020 LM 0,15,SAVEREGS PREPARE TO RETURN 49190020 BR LINK15 RETURN 49200020 SPACE 2 49210020 CNGCYLAA A RWRKREG3,CNGCYLX CC=CC+1;HH=0 49220020 B GO1 RETURN 49230020 SPACE 1 49240020 RTURNX LM 0,15,SAVEREGS 49250020 B EXTNT3 NO SPACE RETURN 49260020 SPACE 1 49270020 SETCC MVC CNGCYLX+2(2),FFF9 SET CYLINDER TO BE CCHH AS 2311. 49280020 MVI BMPTK1+K1,H07 SET INCREMENT VALUE S20201 49290020 L RWRKREG3,CCHHB RIGHT HALF=CCCCCHH (BITS) 49300020 NI CCHHB+3,X'07' OF CCHHB 49310020 SRL RWRKREG3,3 ONLY CC INREG3 49320020 STH RWRKREG3,CCHHB NOW CCHHB IN NORMAL CCHH FORMAT 49330020 L RWRKREG3,CCHHE SAME 49340020 NI CCHHE+3,X'07' FOR 49350020 SRL RWRKREG3,3 CCHHE 49360020 STH RWRKREG3,CCHHE 49370020 B GETXX1 RETURN 49380020 SPACE 1 49390020 SETCCMF LA REGD,CCHHB PREPARE TO CONVERT CYLINDER/TRK 49400020 BAL LINK9,MOVEBIG GO TO CONVERT ROUTINE 49410020 LA REGD,CCHHE PREPARE AGAIN 49420020 BAL LINK9,MOVEBIG GO AGAIN 49430020 MVI CNGCYLX+2,X'FF' MODIFY FOR CYL/TRK-NOT-SC/ST/CH 49440020 B GETXX1 RETURN 49450020 SPACE 1 49460020 MOVEBIG MVC BIGCCHH+1(1),0(REGD) 49470020 MVC BIGCCHH+3(1),1(REGD) STRIP AND 49480020 MVC BIGCCHH+5(1),2(REGD) CYLINDER ON HALF WORD BNDRY 49490020 MVI 2(REGD),X'00' CLEAR CYL OF CCHH(B)OR(E) 49500020 LH REGE,BIGCCHH GET SUBCELLS 49510020 MH REGE,H10 X10= STRIPS 49520020 AH REGE,BIGCCHH+2 +STRIPS=TOTAL STRIPS. 49530020 MH REGE,H05 X5 =CYLINDERS 49540020 AH REGE,BIGCCHH+4 +CYLINDERS=TOTAL CYLINDERS 49550020 STH REGE,0(REGD) SAVE IN CCHH(B)OR (END) 49560020 BR LINK9 RETURN 49570020 EJECT 49580020 * CONVERT FROM CCHH TO RELATIVE TRACK ADDRESS 49590020 SPACE 2 49600020 * UPON ENTERING 49610020 * 1) CCHH EXPECTED IN RWRKREG3 49620020 * 3) RLINK9 CONTAINS RETURN ADDRESS 49630020 SPACE 1 49640020 * 4) THE RELATIVE TRACK ADDRESS WILL BE 49650020 * STORED IN RWRKREG4 WHEN LEAVING 49660020 SPACE 1 49670020 CNVRTRTA SR RWRKREG6,RWRKREG6 CLEAR 49680020 LR RWRKREG4,RWRKREG3 TRANSFER CCHH TO ODD REG. S20201 49690020 SLDL RWRKREG6,16 GET CC OF CCHHB ISOLATED 49700020 MH RWRKREG6,TCTABLE MULT BY NUMBER TRKS/CYL 49710020 SRL RWRKREG4,L16 PREPARE HH S20201 49720020 AR RWRKREG4,RWRKREG6 ADD FOR TOTAL TRACKS S20201 49730020 BR RLINK9 RETURN 49740020 SPACE 2 49750020 * CONTROL AREA FOR GETXXYYZ 49760020 DS 0F GET XXYYZ ON FULL WORD BOUNDARY 49770020 CCHHB DC XL4'0' BWGIN CCHH 49780020 CCHHE DC XL4'0' END CCHH 49790020 XXYYZ DC XL5'00' CONVERTED FORMAT 5 EXTENT 49800020 DC H'0' 49810020 FFF9 DC X'FFF9' 49820020 H05 DC H'5' CYLINDERS/STRIP 49830020 H10 DC H'10' STRIPS/SUBCELL 49840020 BIGCCHH DC 3H'0' AREA FOR CCHH EXPANDED 49850020 EJECT 49860020 * ******************************************** 49870020 * * INDEXING FACTOR TO ERROR MESSAGE TABLE. * 49880020 * ******************************************** 49890020 SPACE 2 49900020 EMES01 EQU 0 COMMAND REJECT. 49910020 EMES02 EQU 24 INTERVENTION REQUIRED. 49920020 EMES03 EQU 48 BUS OUT CHECK 49930020 EMES04 EQU 72 EQUIPMENT CHECK. 49940020 EMES05 EQU 96 DATA CHECK. 49950020 EMES06 EQU 120 OVER RUN CHECK. 49960020 EMES07 EQU 144 TRACK CONDITION CHECK. 49970020 EMES08 EQU 168 DATA CONVERTER CHECK. 49980020 EMES09 EQU 192 END OF CYLINDER. 49990020 EMES10 EQU 216 INVALID ADDRESS ERROR. 50000020 EMES11 EQU 240 NOT AVAILIABLE. 50010020 EMES12 EQU 264 TAPE READ DATA CHECK 50020020 EMES13 EQU 288 COUNT FIELD DATA CHECK. 50030020 EMES14 EQU 312 TRACK OVERRUN ERROR. 50040020 EMES15 EQU 336 FILE PROTECTED DEVICE. 50050020 EMES16 EQU 360 DASD END OF FILE. 50060020 EMES17 EQU 384 DASD NO RECORD FOUND. 50070020 EMES18 EQU 408 END OF TEST TABLE REACHED. 50080020 EMES19 EQU 432 SHOULD NEVER OCCUR MESSAGE. 50090020 EMES20 EQU 456 CHANNEL CONTROL CHECK. 50100020 EMES21 EQU 480 INTERFACE CONTROL CHECK. 50110020 EMES22 EQU 504 CHANNEL DATA CHECK. 50120020 EMES23 EQU 528 DASD OVERFLOW INCOMPLETE. 50130020 EMES24 EQU 552 PROGRAM CHECK. 50140020 EMES25 EQU 576 PROTECTION CHECK. 50150020 EMES26 EQU 600 UNIT EXCEPTION. 50160020 EMES27 EQU 624 INCORRECT LENGTH. 50170020 EMES28 EQU 648 CHAINING CHECK. 50180020 EMES29 EQU 672 INVALID COMMAND SEQUENCE. 50190020 EMES30 EQU 696 SEEK CHECK ERROR. 50200020 EMES31 EQU 720 TAPE WRITE DATA CHECK. 50210020 EMES32 EQU 744 TAPE AT LOAD POINT. 50220020 EMES33 EQU 768 TAPE NOISE RECORD. 50230020 EMES34 EQU 792 MISSING ADDRESS MARKER. 50240020 EMES35 EQU 816 3 BLANK TRACKS ON THIS CYLINDER 50250020 EMES36 EQU 840 3 BLANK CYLINDERS ON THIS STRIP 50260020 EMES37 EQU 864 3 BLANK STRIPS ON THIS SUBCELL 50270020 EMES38 EQU 888 3 BLANK SUBC%LLS ON THIS CELL 50280020 EMES39 EQU 912 BLANK TRACK MESSAGE. 50290020 EMES40 EQU 936 INVALID TRK FMT S20201 50300020 EMES43 EQU 960 INHIBIT WRITE ON M4697 50305020 EJECT 50310020 * ********************************** 50320020 * * IOPRNT ERROR MESSAGE TABLE. * 50330020 * ********************************** 50340020 SPACE 2 50350020 ERRMSG DC C'IBC201W COMMAND REJECT ' 50360020 DC C'IBC202A INTERV. REQUIRED' 50370020 DC C'IBC203W BUS OUT CHECK ' 50380020 DC C'IBC204W EQUIPMENT CHECK ' 50390020 DC C'IBC205W DATA CHECK ' 50400020 DC C'IBC206W OVER RUN ' 50410020 DC C'IBC207W FLAGGED TRACK. ' 50420020 DC C'IBC208W DATA CONV. CHECK' 50430020 DC C'IBC209W END OF CYLINDER ' 50440020 DC C'IBC210W INVALID ADDRESS ' 50450020 DC C'IBC211W NOT AVAILIABLE ' 50460020 DC C'IBC212W READ DATA CHECK ' 50470020 DC C'IBC213W COUNT FIELD CHEK' 50480020 DC C'IBC214W TRACK OVERRUN ' 50490020 DC C'IBC215W FILE PROTECTED ' 50500020 DC C'IBC216W DASD-END OF FILE' 50510020 DC C'IBC217W NO RECORD FOUND ' 50520020 DC C'IBC218W INVALID ERROR ' 50530020 DC C'IBC219W WRONG ERROR ' 50540020 DC C'IBC220W CHAN. CTRL ERROR' 50550020 DC C'IBC221W INTERFACE ERROR ' 50560020 DC C'IBC222W CHAN. DATA CHECK' 50570020 DC C'IBC223W DASD OVERFLOW ' 50580020 DC C'IBC224W PROGRAM CHECK ' 50590020 DC C'IBC225W PROTECTION CHECK' 50600020 DC C'IBC226W UNIT EXCEPTION ' 50610020 DC C'IBC227W INCORRECT LENGTH' 50620020 DC C'IBC228W CHAINING CHECK ' 50630020 DC C'IBC229W COMMAND SEQ .ERR' 50640020 DC C'IBC230W SEEK CHECK ERROR' 50650020 DC C'IBC231W WRITE DATA CHECK' 50660020 DC C'IBC232W TAPE--LOAD POINT' 50670020 DC C'IBC233W NOISE RECORD ' 50680020 DC C'IBC234W MISSING ADR-MARK' 50690020 DC C'IBC239W 3 BLANK TRACKS ' 50700020 DC C'IBC236W 3 BLANK CYLINDER' 50710020 DC C'IBC237W 3 BLANK STRIPS ' 50720020 DC C'IBC238W 3 BLANK SUB CELL' 50730020 BLKMES1 DC C'IBC235I BLANK TRACK ' 50740020 DC C'IBC242W INVALID TRK FMT ' INV TRK FMT S20201 50750020 DC C'IBC243W WRITE INHIBITED ' WRITE INHIBITED M4697 50755020 EJECT 50760020 * ***************************************************** 50770020 * * COMMON COMPUTER INTERRUPT ROUTINES ON THIS PAGE. * 50780020 * ***************************************************** 50790020 SPACE 2 50800020 * EXTERNAL INTERRUPT SUPERVISOR. 50810020 SPACE 1 50820020 EXTINT TM A27,H40 THIS A CONSOLE INTERRUPT S20201 50830020 BC 8,EXTINT1 NO 50840020 MVI REQSW,X'FF' TURN ON REQUEST SWITCH 49363 50842021 LPSW CONTINUE YES - GO TO PRESET LOCATION 50850020 SPACE 1 50860020 EXTINT1 LPSW 24 RETURN TO INTRPT POINT 50870020 SPACE 2 50880020 * PROGRAM INTERRUPT SUPERVISOR. 50890020 SPACE 1 50900020 PGMINT STM 0,15,REGSV SAVE REGISTERS. 50910020 MVC SVPSW(8),40 SAVE OLD PROGRAM INTERRUPT PSW. 50920020 MVC PRWD(27),PGIERR LOAD ERROR MESSAGE IN PRINT FLD. 50930020 MVC PRWD+27(20),QUITJOB LOAD JOB TERMINATED MESSAGE 50940020 LA GR1,47 MESSAGE LENGTH IN BYTES. 50950020 BAL LINK9,PRNT GO TO PRINT ROUTINE. 50960020 LPSW COWAIT WAIT TERMINATE. 50970020 SPACE 1 50980020 PGIERR DC C'IBC152W PROGRAM INTERRUPT.' 50990020 SPACE 2 51000020 * SVC CALL INTERRUPT SUPERVISOR. 51010020 SPACE 1 51020020 SVCINT STM 0,15,REGSV SAVE REGISTERS. 51030020 MVC SVPSW(8),32 SAVE OLD SVC INTERRUPT PSW. 51040020 MVC PRWD(23),ERRSVC LOAD ERROR MESSAGE IN PRINT FLD. 51050020 MVC PRWD+23(20),QUITJOB LOAD JOB TERMINATED MESSAGE. 51060020 LA GR1,43 MESSAGE LENGTH IN BYTES. 51070020 BAL LINK9,PRNT GO TO PRINT ROUTINE. 51080020 LPSW COWAIT WAIT TERMINATE. 51090020 SPACE 1 51100020 ERRSVC DC C'IBC104W SVC INTERRUPT.' 51110020 SPACE 2 51120020 EJECT 51130020 ORG ENTER+18432 HEX E5 BUFFER S20201 51140020 SPACE 1 51150020 TAB5E DC XL4'0' TABLE OF HEX E5 FOR 2321. 51160020 * TABLE OF HEX 55 FOR ALL OTHERS. 51170020 DS 2D 51180020 WRTDSCB DS 130D 51190020 CNTFIELD DS 65D 51200020 SPACE 1 51210020 SAVECCWS DS 0D 51220020 SPACE 2 51230020 ORG ENTER+25856 HEX 00 BUFFER S20201 51240020 TAB13 DC XL4'0' TABLE OF ZEROS FOR NON-2321. 51250020 SPACE 2 51260020 EJECT 51270020 * READY TO READ TRK 0 OF EACH CYLINDER OF A STRIP 51280020 SPACE 1 51290020 CONTROL NC BLKTRKSW(4),FFFFFF00 RESET (TRK) BLANK SWITCH 51300020 MVC TRKCTRL(8),TRKHOLD GET CONTROL CYL CNG/NO-CYL/ST 51310020 LA GR15,BLKTRKSW+2 CYLINDER CHECK 51320020 N RTRKADR,FFFF0000 CLEAR CYL/TRK FOR CYL CHECK 51330020 BAL RLINK4,READCT2 DO 30 51340020 SPACE 1 51350020 * FINISHED WITH A STRIP 51360020 SPACE 1 51370020 NC BLKTRKSW(4),FFFF0000 RESET (CYLINDER) BLANK SWITCH 51380020 LA GR15,BLKTRKSW+1 STRIP CHECK 51390020 A RTRKADR,Z000FB00 UPDATE STRIP ADDRESS 51400020 ST RTRKADR,SAVERTRK GET TRK ADDR IN CORE 51410020 CLC SAVERTRK(2),L3050500 END OF ORIGINALS 51420020 BE LSTSCELL YES, SEEK 1ST TRK OF SUBCELLS 51430020 CLI BLKTRKSW+1,X'00' REWRITE - BLANK ON STRIP 51440020 BNE CONTROL1 YES - RECHECK STRIPS 51450020 CLI SAVERTRK+1,X'0A' TO CHECK STRIP NUMBER 51460020 BL WRITECT1 NOT LAST; CHECK MORE TRACKS 51470020 SPACE 1 51480020 NC BLKTRKSW(4),FF000000 RESET (STRIP) BLANK SWITCH 51490020 CONTROL1 MVC TRKCTRL(8),TRKHOLD+8 LAST CHECK X,0,0,0 51500020 LA GR15,BLKTRKSW+1 STRIP CHECK. 51510020 N RTRKADR,FF000000 RESET STRP=0,CYL=0,TRK=0 51520020 CLI SAVERTRK,X'13' LAST ALTERNATE STRIP 51530020 BE EALTS YES, GO GET ORIGINALS 51540020 BAL RLINK4,READCT2 GO FINISH UP 51550020 SPACE 1 51560020 * FINISHED WITH ALL STRIPS OF A CELL 51570020 SPACE 1 51580020 CLI BLKTRKSW,X'00' REWRITE - BLANK ON SUBCELL 51590020 BNE LSTSCELL YES - RECHECK SUBCELLS 51600020 A RTRKADR,Z0F60000 UPDATE STRIP ADDRESS 51610020 B WRITECT1 WRITE SOME MORE SUBCELLS 51620020 SPACE 1 51630020 EALTS SR RTRKADR,RTRKADR END OF ALTERNATES 51640020 MVI STRTADR+1,X'00' RESET FLAG FOR ORIGINALS 51650020 B WRITECT1 START ON ORIGINALS 51660020 SPACE 1 51670020 LSTSCELL MVC TRKCTRL(8),TRKHOLD+16 SET UP FOR TRK0 OF SUBCELLS 51680020 LA GR15,BLKTRKSW SUBCELL CHECK POINTER. 51690020 SR RTRKADR,RTRKADR CLEAR ADDRESS TO CK 51700020 BAL RLINK4,READCT2 0,0,0,0 TO 19,0,0,0 51710020 B CONSTR1 51720020 SPACE 1 51730020 WRITECTA LA RCAW,CKBALLST SEEK TO ZERO 51740020 LA RUCB,UCBTO TO BE SURE 51750020 MVC SEEKADR+2(4),CLEAR NOT BALLAST 51760020 BAL LINK9,STARTIO 51770020 SPACE 1 51780020 * STATUS RTRKADR = X,X,X,0 (SC,S,C,T) 51790020 WRITECT1 LA RCAW,MFWANAL POINTER TO CCW LIST 51800020 LA RLOOPCTR,21 SET COUNTER FOR 20 TRKS/CYL 51810020 LA GR15,BLKTRKSW+3 TRACK CHECK 51820020 BAL RLINK9,BCT1 SET RETURN ADDRESS 51830020 A RTRKADR,F1 UPDATE TRACK ADDRESS 51840020 BCT1 BCT RLOOPCTR,INITWRCY UPDATE LOOP COUNTER 51850020 B READCT1 DONE- GO TO READ ROUTINE 51860020 SPACE 2 51870020 READCT1 LA RCAW,MFRANAL POINTER TO CCW LIST 51880020 MVI MFRAHA+4,X'40' RESET CHAIN COMMAND FLAG 51890020 IC RTRKADR,CLEAR RESET TRACK ADDRESS 51900020 LA RLOOPCTR,21 51910020 BAL RLINK9,BCT2 SET RETURN ADDRESS 51920020 BCT2A CLC STRTADR+2(4),CCHHCK+1 DOES READ HA AGREE WITH WRITE 51930020 STM 0,15,ERRSAV1 STORE IN CASE OF ERROR 51940020 BNE ACTVIIIA NO - HANDLE ERROR 51950020 A RTRKADR,F1 UPDATE TRACK ADDRESS 51960020 BCT2 BCT RLOOPCTR,INITWRCY CHECK/UPDATE LOOP COUNTER 51970020 LA RCAW,MFERASE POINTER TO CCW LIST 51980020 LA RLOOPCTR,21 SET COUNTER FOR TRACK 51990020 IC RTRKADR,CLEAR RESET TRACK ADDRESS 52000020 BAL RLINK9,BCT2X SET RETURN ADDRESS 52010020 A RTRKADR,F1 UPDATE TRACK ADDRESS 52020020 BCT2X BCT RLOOPCTR,INITWRCY UPDATE LOOP COUNTER 52030020 CLI BLKTRKSW+2,X'00' REWRITE -BLANK ON CYLINDER 52040020 BNE CONTROL YES - RECHECK CYLINDERS 52050020 A RTRKADR,FXEC CHANGE CYLINDERS 52060020 NC BLKTRKSW(4),FFFFFF00 RESET BLANK TRACK SWITCH. 52070020 ST RTRKADR,SAVERTRK LAST 52080020 CLC SAVERTRK+2(2),HALF500 CYLINDER 52090020 BL WRITECT1 NO, WRITE SOME MORE 52100020 B CONTROL YES, CHECK STATUS 52110020 SPACE 2 52120020 READCT2 LA RCAW,MFRANAL POINTER TO CCW LIST 52130020 MVI MFRAHA+4,X'00' KILL READ BACK CHECK 52140020 L RLOOPCTR,TRKCTRL SET COUNTER FOR CYL/STRIP/SUBC 52150020 BAL RLINK9,BCT3 SET RETURN ADDRESS 52160020 CLC STRTADR+2(4),CCHHCK+1 DOES READ HA AGREE WITH WRITE 52170020 STM 0,15,ERRSAV1 STORE IN CASE OF ERROR 52180020 BNE ACTVIIIA NO - HANDLE ERROR 52190020 A RTRKADR,TRKCTRL+4 UPDATE TRACK ADDRESS 52200020 BCT3 BCT RLOOPCTR,INITWRCY CHECK ; UPDATE COUNTER; GO 52210020 BR RLINK4 RETURN SOMEWHERE IN CONTROL 52220020 SPACE 2 52230020 INITWRCY LA RUCB,UCBTO POINTER TO UCB 52240020 STM 0,15,REGSV2 SAVE REGISTERS IN CASE OF ERROR. 52250020 ST RTRKADR,ROCOUNT 52260020 ST RTRKADR,XR1CNTMF R1 COUNT FIELD 52270020 ST RTRKADR,SEEKADR+2 STORE TRACK ADDRESS IN SEEK 52280020 ST RTRKADR,STRTADR+2 HOME ADDRESS 52290020 OI CCHHCK+1,X'80' RESET TO GUARANTEE GOT STRIP 52300020 B STARTIO 52310020 SPACE 1 52320020 * RETURN HERE AFTER ASSIGNING AN ALTERNATE TRACK. 52330020 MALTRTN LM 0,15,REGSV2 SET REGISTERS AS PRIOR TO ERROR. 52340020 MVI ERRETRY,X'00' TURN OFF ERROR RETRY SWITCH. 52350020 BR LINK9 RETURN AS NORMAL RETURN. 52360020 * CCW LISTS 52370020 TRKBLK CLI ERASESW,X'FF' PREVIOUS DATA CHECK DURING ERASE 52380020 MVI ERASESW,X'00' INSURE THAT SWITCH IS RESET. 52390020 BC 8,INITWRCY YES-REPEAT ERASE FOR THIS TRACK. 52400020 LA RCAW,MFWANAL GET POINTER FOR WRITE. 52410020 BAL RLINK9,INITWRCY REWRITE TRACK 52420020 B READCT1 TRY READ AGAIN 52430020 SPACE 1 52440020 SPACE 2 52450020 * WRITE TRACK ANALYSIS CCW LIST 52460020 MFWANAL CCW 7,SEEKADR,X'40',6 SEEK BIN/CYL 52470020 CCW X'1F',SETFMK,X'40',1 SET FILE MASK/ALLOW ALL WRITES 52480020 CCW X'19',STRTADR+1,X'40',5 WRITE HOME ADDRESS 52490020 CCW X'15',ROCOUNT,X'40',16 WRITE R0 52500020 CCW X'1D',XR1CNTMF,X'80',8 WRITE R1 COUNT FIELD 52510020 MFWANLX CCW X'1D',TAB5E,X'20',1992 52520020 CCW 8,MFRAHA,X'60',1 52530020 * READ TRACK ANALYSIS CCW LIST 52540020 MFRANAL CCW 7,SEEKADR,X'40',6 SEEK BIN/CYL 52550020 CCW 31,SETFMK,X'40',1 SET FILE MASK/ALLOW ANYTHING 52560020 MFRAHA CCW X'1A',CCHHCK,X'40',5 READ HA 52570020 CCW X'16',ROCOUNT,X'50',16 READ BACK CHECK R0. 52580020 CCW X'1E',TAB5E,X'30',2000 READ BACK CHECK R1 52590020 * ERASE TRACK CCW LIST 52600020 MFERASE CCW 7,SEEKADR,X'40',6 SEEK BIN/CYLINDER 52610020 CCW X'1F',SETFMK,X'40',1 ALLOW ANYTHING 52620020 MFES CCW X'31',ROCOUNT,X'40',5 SEARCH ON R0 COUNT 52630020 CCW 8,MFES,X'40',1 TRANSFER UNTIL FOUND. 52640020 CCW X'11',CLEAR,X'20',8 ERASE REMAINDER OF TRACK 52650020 CKBALLST CCW 7,SEEKADR,X'20',6 SEEK TO FIRST TRACK OF BIN 52660020 XR1CNTMF DC X'00000000010007C8' COUNT FIELD FOR RECORD 1. 52670020 EJECT 52680020 * FULL WORD BOUNDARY 52690020 SPACE 1 52700020 DS 0F 52710020 SPACE 1 52720020 ABLKTRK DC A(BLKTRKSW+3) 52730020 CCHHCK DC 2F'0' 52740020 FXEC DC X'000000EC' CHANGE CYLINDERS 2321 52750020 FFFF0000 DC X'FFFF0000' CLEAR CYLINDER/TRACK 2321 52760020 SAVERTRK DC F'0' SAVE TRACK ADDRESS TO CK 52770020 TRKCTRL DC 2F'0' WORK AREA TO CK,CYL,STRIP,SUBC 52780020 TRKHOLD DC F'6' CYL/STRIP - STOPING FACTOR 52790020 DC X'00000100' INCRIMENT FACTOR CYL -2321 52800020 DC F'11' STP/SCELL - STOPING FACTOR 52810020 DC X'00010000' INCRIMENT FACTOR STP -2321 52820020 DC F'21' SCELL/CELL - STOPING FACTOR 52830020 DC X'01000000' INCRIMENT FACTOR SCELL - 2321 52840020 FF000000 DC X'FF000000' CLEAR STP/CYL/TRK 52850020 L3050500 DC X'13060000' END OF ORIGINAL TRACKS. 52860020 BLKTRKSW DC F'0' 52870020 FFFFFF00 DC X'FFFFFF00' 52880020 ABLKSTRP DC A(BLKTRKSW+1) 52890020 EJECT 52900020 * HALF WORD BOUNDARY 52910020 DS 0H 52920020 HALF500 DC X'0500' 52930020 EJECT 52940020 * NO BOUNDARY 52950020 SPACE 1 52960020 BLKTRACK STM 0,15,REGSV3 SAVE 52970020 MVC PRWD(20),BLKMES1 HEADER MESSAGE. 52980020 LA 1,75 COUNT FOR LONGEST 52990020 BAL LINK9,PRNT PRINT IT 53000020 MVC PRWD(74),BLKMES2 A BLANK TRACK; DISCRIPTOR 53010020 BAL LINK9,PRNT PRINT IT 53020020 UNPK BLKSAV(9),STRTADR+2(5) HOME ADDRESS EXPECTED 53030020 UNPK BLKSAV+8(9),CCHHCK+1(5) HOME ADDRESS GOTTEN 53040020 UNPK BLKSAV+16(9),BLKTRKSW(5) SWITCH TELLS TR,CY,ST,OR SC 53050020 UNPK BLKSAV+24(9),16(5,UCBREG) CSW LEFT HALF 53060020 UNPK BLKSAV+32(9),20(5,UCBREG) CSW RIGHT HALF 53070020 UNPK BLKSAV+40(13),24(7,UCBREG) SENSE BYTES (6) 53080020 TR BLKSAV(48),IOTAB-240 MAKE PRINTABLE 53090020 LM 0,5,BLKSAV MOVE 53100020 STM 0,1,PRWD HA EXPECTED 53110020 STM 2,3,PRWD+12 HA GOTTEN 53120020 STM 4,5,PRWD+24 SWITCH ALL TO PRINT BUFFER 53130020 LM 0,6,BLKSAV+24 MOVE 53140020 STM 0,1,PRWD+36 CSW LEFT HALF 53150020 STM 2,3,PRWD+48 CSW RIGHT HALF 53160020 STM 4,6,PRWD+60 SENSE BYTES ALL TO PRINT 53170020 LA 1,75 LENGTH OF LONGEST MESSAGE. 53180020 BAL LINK9,PRNT PRINT INFORMATION 53190020 BAL LINK9,PRNT SPACE A LINE 53200020 LM 0,15,REGSV3 RESTORE REGISTERS 53210020 BR LINK14 PRINT A LINE 53220020 SPACE 1 53230020 BLKMES2 DC C' SEEKED FOUND SCSTCYTR CSW LEFT' 53240020 DC C' CSW RIGHT SENSE BYTES ' 53250020 SPACE 1 53260020 BLKSAV DC 7D'0' 53270020 RLINK4 EQU 4 53280020 RLINK5 EQU 5 53290020 RCAW EQU 3 53300020 RUCB EQU 2 53310020 RLOOPCTR EQU 6 53320020 RTRKADR EQU 7 53330020 SPACE 1 53340020 END START 53350020 ./ ADD SSI=19010513,NAME=IBCDMPRS,SOURCE=0 PRINT OFF 00000621 REPRO 00001221 0@@ &@ DASDI - DUMP/RESTORE 00001821 REPRO 00002421 @ &@ &@Q &'&0ؗ-}&1&&ɺ0--0ӆ 0ɺ00003021 REPRO 00003621 0-0φ 0nS10nL10nX1-0 1ه1 1 000Ӈ100004221 REPRO 00004821 07}&0&*b1nN1-0 -}b}1 &1͠^0&11 00005421 REPRO 00006021 ^0n,000ӄnF0ɹnF0i1ɡ00006621 REPRO 00007221 1 0'<&C 00007821 PRINT ON 00008421 TITLE 'DUMP/RESTORE - IBCDMPRS' 00010020 ENTER START 0 00020020 ORG ENTER 00030020 ORG0000 EQU * 00040020 * 00050020 * RELEASE 21 DELETIONS/CHANGES 00060020 * M0159 00065021 * 00070020 * RELEASE 20 DELETIONS/CHANGES 00080020 * A37519 THIS APAR HAS BEEN FIXED UNDER S20201. A37519 00083020 * 384000,384200 A36316 00086020 * 001300,078600,793200-804000,838800 M0989 00090020 * 001300,014600,031400,064200-064800,065800,066400,067000,071200,S20201 00100020 * 075200,078600,087600,088200,102800,107200,108600,118800,119400,S20201 00110020 * 133000-133200,133600-133800,134200,134800-135000,135400,136000,S20201 00120020 * 136600-136800,152948-152952,152956-152960,152964,170600,171200,S20201 00130020 * 199200,199800,205800,207000,214600,214800,215000,215200,215400,S20201 00140020 *215600,215800,216000,216200,216400,216800,240000,240600,246600, S20201 00150020 * 247200-247800,248200,248600,249000,249400,249800,250200,257400,S20201 00160020 * 257600,277200,277400,278600-298200,307600,307800,308800,309000,S20201 00170020 * 312600-330000,338400,338600,384600,433400,460800,483400-489800,S20201 00180020 * 491000-497800,628600,728400,775000,836200,838609-838978,858400,S20201 00190020 * 889000-890400,917400-932400,014800 S20201 00200020 * 430600 M5715 00202020 * M5581 00205020 * 461000,462500 M6370 00207020 * 00210020 * RELEASE 19 DELETIONS/CHANGES 00220020 * 122400-122600,125600,142000 A22281 00230020 * 078600,397800,398400,531400,546900-547200 A27583 00240020 * 534400 A23097 00250020 * A26319 00260020 * 947800,950400 A30065 00270020 * A23657 00280020 * 00290020 *STATUS - CHANGE LEVEL 7.7 -- OS RELEASE 21.7 -- 7/28/72 00300021 * * 00310020 *FUNCTION/OPERATION- DUMPING AND RESTORING THE DATA ON DIRECT ACCESS * 00320020 * VOLUMES. * 00330020 * * 00340020 * DUMP- DUMPING(COPYING) DATA FROM A DIRECT ACCESS VOLUME TO 2311 * 00350020 * DISK STORAGE OR MAGNETIC TAPE, IN A FORMAT RECOGNIZABLE TO THE * 00360020 * RESTORE PORTION OF THE PROGRAM. A DUMP MAY BE EITHER PARTIAL (A * 00370020 * SET OF CONTIGUOUS TRACKS IS DUMPED) OR ENTIRE (THE ENTIRE VOLUME * 00380020 * IS DUMPED). THE FORMAT OF THE OUTPUT IS DESCRIBED UNDER THE HEAD- * 00390020 * ING -OUTPUT-. * 00400020 * * 00410020 * RESTORE- RESTORING(RECOPYING) DATA WHICH HAS BEEN DUMPED BY THIS * 00420020 * PROGRAM. DATA IS RESTORED ONLY TO A VOLUME RESIDING ON THE SAME * 00430020 * DEVICE TYPE FROM WHICH IT WAS DUMPED. * 00440020 * * 00450020 *ENTRY POINTS- CONTROL IS GIVEN TO LOCATION -START- BY THE ABSOLUTE * 00460020 * LOADER, WHICH CONSTITUTES THE FIRST PART OF THE PROGRAM. CONTROL * 00470020 * CARDS ARE READ AND ANALYSED TO DETERMINE IF DUMP OR RESTORE IS * 00480020 * TO BE EXECUTED. * 00490020 * BOTH DUMP AND RESTORE ARE ENTERED AT LOCATION -START1-. AFTER * 00500020 * SOME INITIALIZATION PROCEDURES, A SWITCH, NAMED -SEQSW-, IS * 00510020 * TESTED TO DETERMINE WHICH FUNCTION (EITHER DUMP OR RESTORE) * 00520020 * SHOULD BE GIVEN CONTROL. * 00530020 * * 00540020 *INPUT- DUMP- CONTROL STATEMENTS, DIRECT ACCESS DEVICE DATA. * 00550020 * RESTORE- CONTROL STATEMENTS, TAPE PRODUCED BY DUMP. * 00560020 * * 00570020 *OUTPUT- DUMP- THE DATA READ FROM THE SPECIFIED TRACKS ON THE SPEC- * 00580020 * IFIED DIRECT ACCESS VOLUME IS WRITTEN EITHER ON A 2311 DISK * 00590020 * OR ON MAGNETIC TAPE. IF THE OUTPUT DEVICE IS TAPE, THE FOLLOWING * 00600020 * RECORDS ARE WRITTEN. * 00610020 * * 00620020 * LIMITS RECORD. THIS IS WRITTEN AS THE FIRST RECORD (FOLLOWING * 00630020 * ANY LABELS) ON EACH VOLUME OF TAPE. THIS RECORD CONTAINS THE * 00640020 * ADDRESSES OF THE FIRST TRACK DUMPED, ONE GREATER THAN THE LAST * 00650020 * TRACK DUMPED,THE FIRST TRACK ON THIS VOLUME OF TAPE, AND A FULL * 00660020 * RESTORE SWITCH. * 00670020 * * 00680020 * CONTROL RECORD. THIS RECORD IS WRITTEN FOR EACH TRACK DUMPED AND * 00690020 * IMMEDIATELY PRECEDES THE DUMPED DATA FROM THE TRACK. THE CONTROL * 00700020 * RECORD CONTAINS CHANNEL PROGRAM CCWS WHICH ARE USED BY A SUB- * 00710020 * SEQUENT RESTORE TO WRITE ONE TRACK. * 00720020 * * 00730020 * TRACK IMAGE. THIS RECORD CONTAINS THE DATA DUMPED FROM THE TRACK * 00740020 * AND IS WRITTEN AS ONE MAXIMUM LENGTH PHYSICAL RECORD. A TRACK * 00750020 * IMAGE IS NEVER SPLIT BETWEEN TAPE VOLUMES. * 00760020 * * 00770020 * TRAILER LABEL. THIS RECORD IS WRITTEN AT THE END OF EACH TAPE * 00780020 * VOLUME, IMMEDIATELY FOLLOWING A TAPE MARK. THIS LABEL INDICATES * 00790020 * WHETHER ANOTHER FROM VOLUME IS TO BE MOUNTED DURING RESTORE. * 00800020 * * 00810020 * FOR A 2311 TO 2311 DUMP, DATA IS COPIED RECORD FOR RECORD AND * 00820020 * TRACK FOR TRACK. * 00830020 * * 00840020 * FOR A NON-2311 TO 2311 DUMP, THE SAME RECORDS ARE WRITTEN AS FOR * 00850020 * TAPE AND ARE AT THE FOLLOWING LOCATIONS. * 00860020 * THE LIMITS RECORD IS WRITTEN AS RECORD ONE OF TRACK ONE FOR EACH * 00870020 * 2311 VOLUME NEEDED. * 00880020 * THE FIRST CONTROL RECORD IS WRITTEN AS RECORD ONE OF TRACK TWO; * 00890020 * SUBSEQUENT CONTROL RECORDS ARE EACH WRITTEN AS RECORD ONE OF THE * 00900020 * FIRST TRACK FOLLOWING THE IMAGE OF THE LAST TRACK DUMPED. * 00910020 * THE TRACK IMAGE IS WRITTEN IN MAXIMUM LENGTH PHYSICAL RECORDS * 00920020 * ON AS MANY 2311 TRACKS AS ARE NECESSARY. * 00930020 * THE TRAILER LABEL IS WRITTEN AS RECORD ONE ON THE LAST AVAILABLE * 00940020 * TRACK ON EACH 2311 DISK PACK USED. * 00950020 * * 00960020 * NOTE- 2314 AND 3330 MAY BE SUBSTITUTED FOR 2311 IN THE ABOVE * 00970020 * DESCRIPTION. THESE DEVICES ARE HANDLED IN THE SAME MANNER AS * 00980020 * THE 2311. * 00990020 * * 01000020 * THE OUTPUT OF THE RESTORE FUNCTION IS A DIRECT ACCESS DEVICE * 01010020 * FORMATTED IDENTICALLY TO THE DIRECT ACCESS DEVICE THAT HAD BEEN * 01020020 * PREVIOUSLY DUMPED. * 01030020 * * 01040020 *EXITS-NORMAL- SUCCESSFUL COMPLETION OF DUMP OR RESTORE RESULTS IN * 01050020 * A WAIT PSW WITH E'S IN THE ADDRESS FIELD FOR DISPLAY IN THE * 01060020 * CONSOLE LIGHTS. AN END OF JOB MESSAGE IS ALSO GIVEN ON THE * 01070020 * MESSAGE DEVICE. * 01080020 * * 01090020 *EXITS-ERROR- A WAIT PSW IS LOADED WITH E'S IN THE ADDRESS FIELD * 01100020 * FOR DISPLAY IN THE CONSOLE LIGHTS. ERROR STOPS, WHENEVER * 01110020 * POSSIBLE, ARE PRECEDED BY A MESSAGE WHICH DEFINES THE ERROR. * 01120020 * THE MESSAGE IS GIVEN ON THE MESSAGE DEVICE OR OPERATORS CONSOLE. * 01130020 * MACHINE CHECK INTERRUPTS RESULT IN THE LOADING OF A PSW IN THE * 01140020 * WAIT STATE WITH E2 IN THE ADDRESS FIELD FOR DISPLAY IN THE * 01150020 * CONSOLE LIGHTS. CONSTANTS ARE SET FOR THE RUNNING OF THE SEREP * 01160020 * PROGRAM AFTER DUMP/RESTORE HALTS ON MACHINE CHECK OR I/O DEVICE * 01170020 * MALFUNCTION. * 01180020 * * 01190020 *EXTERNAL ROUTINES- DUMP/RESTORE REQUIRES SOME INFORMATION FROM THE * 01200020 * OPERATOR AS TO THE LOCATION OF THE TYPEWRITER CONSOLE (IF ANY), * 01210020 * AND THE INPUT SOURCE FOR THE CONTROL STATEMENTS. ON INITIAL * 01220020 * LOADING OF DUMP AND RESTORE, THE PROGRAM HALTS IN A WAIT STATE * 01230020 * WITH F'S DISPLAYED IN THE CONSOLE LIGHTS. IF A CONSOLE TYPE- * 01240020 * WRITER IS AVAILABLE, THE OPERATOR DEPRESSES THE REQUEST KEY AND * 01250020 * THIS IDENTIFIES THE LOCATION OF THE TYPEWRITER TO DUMP OR RESTORE * 01260020 * AND A MESSAGE IS GIVEN ASKING THE OPERATOR TO DEFINE THE INPUT * 01270020 * DEVICE FOR THE CONTROL STATEMENTS. THE OPERATOR THEN TYPES IN * 01280020 * LOWER OR UPPER CASE FOR EXAMPLE- * 01290020 * INPUT=1402 00C * 01300020 * WHICH TELLS DUMP/RESTORE TO GO TO A 1402 READER ON CUU 00C FOR * 01310020 * CONTROL CARDS. * 01320020 * IF A CONSOLE TYPEWRITER IS NOT AVAILABLE, THE OPERATOR ENTERS * 01330020 * INTO HEX LOCATIONS 0110 AND 0111, ONE OF THE FOLLOWING CODES- * 01340020 * XCUU WHERE X=0 FOR A 2540 READER, 1 FOR A 1402/1442 * 01350020 * READER, AND 2 FOR A 2400 NINE TRACK TAPE. CUU IS THE CHANNEL/ * 01360020 * UNIT ADDRESS OF THE INPUT DEVICE. * 01370020 * * 01380020 *TABLES/WORK AREAS- * 01390020 * -OPRTAB- A LIST OF VALID COMMAND WORDS USED ON CONTROL CARDS. * 01400020 * -KEYTAB- A LIST OF VALID KEY WORDS USED ON CONTROL CARDS. * 01410020 * -SYINTAB-A LIST OF VALID INPUT DEVICES FOR CONTROL CARDS. * 01420020 * -DEVTAB- A LIST OF VALID DEVICES HANDLED BY DUMP/RESTORE. * 01430020 * -DEVCTRL-A LIST OF CONSTANTS FOR SPECIFIC DEVICE TYPES. * 01440020 * -CONVTAB-A TABLE USED TO CONVERT CONSOLE INPUT TO UPPER CASE. * 01450020 * -IOTAB- A TABLE USED TO CONVERT HEX TO EBCDIC GRAPHIC. * 01460020 * -CTBUFFER- A BUFFER CONTAINING THE COUNT FIELDS THAT ARE READ * 01470020 * IN FROM THE DIRECT ACCESS DEVICE BEING DUMPED. * 01480020 * -DTABUFF- A BUFFER CONTAINING THE DATA FIELDS THAT ARE READ * 01490020 * IN FROM THE DIRECT ACCESS DEVICE BEING DUMPED. * 01500020 * * 01510020 *ATTRIBUTES- PRIVILEGED, DISABLED, NON-RELOCATEABLE, NON-REUSABLE. * 01520020 * CHARACTER DEPENDENT TABLE AT -CONVTAB-. * 01530020 * * 01540020 SPACE 3 01550020 *********************************************************************** 01560020 * * 01570020 * WARNING- THE FOLLOWING LOCATIONS MUST BE CONSTANT FROM * 01580020 * LEVEL TO LEVEL FOR COMPATIBILITY. * 01590020 * * 01600020 * 1) CLEARV3 * 01610020 * 2) CLEAR * 01620020 * 3) FILEMASK * 01630020 * 4) BBCCHH * 01640020 * 5) DATALENG * 01650020 * 6) DTABUFF * 01660020 * 7) CTBUFFER * 01670020 *NOTE THAT 'START1A' IS ALSO 'ORGED' AT LOCATION 2000.' 01680020 *********************************************************************** 01690020 * 01700020 * 01710020 *1766,383000,413600-413800,420400-420600 7849 01720020 *1766,001000,074800,618200-619800,626400 8327 01730020 *1766 5981 01740020 *1766,067200,074800,001000,125800-126000,125460 7674 01750020 *1766621000 01760020 *3304124600 2711 01770020 *3304125000 2711 01780020 *NOTE CHANGE IN SEQUENCE NUMBERS BETWEEN RELEASE 17 AND RELEASE 18 01790020 *3304528400,528600,530400,531040,531200,546000,546800-547000,7596003479 01800020 *3304531000,535200,757200-757400,774600 2324 01810020 EJECT 01820020 USING IPLPSW,BASE0,BASE10,12,13 01830020 SPACE 1 01840020 IPLPSW DC X'0004' IPLPSW 01850020 DS 2X DO NOT OVERLAY IPLED DEVICE 5274 01860020 DC A(START) INITIAL ECS ENTRY POINT 01870020 SPACE 1 01880020 * COMMON STORAGE AREAS USED BY ALL SECTIONS 01890020 SPACE 2 01900020 ORG0000X EQU * 5274 01910020 ORG ENTER+272 5274 01920020 ORG0100 EQU * 5274 01930020 INPUTDEV DC X'BAD0' DEFINE INPUT TYPE OR CONSOLE 01940020 ORG0100X EQU * 5274 01950020 ORG ENTER+384 5274 01960020 ORG0200 EQU * 5274 01970020 SAVEPSW DC 1D'0' 6379 01980020 SPACE 2 01990020 ORG0200X EQU * 5274 02000020 ORG ENTER+408 5274 02010020 ORG0300 EQU * 5274 02020020 SPACE 2 02030020 * GENERAL PURPOSE REGISTER SAVE AREAS 02040020 SPACE 2 02050020 REGSV1 DC 2F'0' SCAN REG SAVE AREA 02060020 SPACE 2 02070020 SPACE 2 02080020 REGSV2 DC 16F'0' USED BY DATA INPUT ROUTINE 02090020 SPACE 2 02100020 REGSV4 DC 16F'0' USED BY MESSAGE OUTPUT ROUTINE 02110020 SPACE 2 02120020 REGSV5 DC 16F'0' USED BY I/O INTERRUPT ROUTINE. 02130020 SPACE 2 02140020 REGSV6 DC 16F'0' USED BY WRITE TO OPERATOR 02150020 SPACE 2 02160020 REGSV7 DC 16F'0' USED BY ERROR MSG PRINT 02170020 SPACE 2 02180020 ERRSAV1 DC 16F'0' USED IN CASE OF I/O ERRORS. 02190020 SPACE 2 02200020 REGSIO DC 16F'0' USED DURING I/O ROUTINE. 02210020 EJECT 02220020 * ********************************************** 02230020 * * UNIT CONTROL BLOCK * 02240020 * ********************************************** 02250020 * * * 02260020 * * BYTE FUNCTION * 02270020 * * 00 UNIT REFERENCE NUMBER * 02280020 * * 01 I/O STARTED * 02290020 * * 02-03 CHANNEL AND UNIT NUMBER * 02300020 * * 04 CAW PROTECT * 02310020 * * 05-07 CAW (IN ERROR) * 02320020 * * 08-15 INTERRUPT PSW * 02330020 * * 16-23 INTERRUPT CSW * 02340020 * * 24-29 SENSE INFORMATION * 02350020 * * 30-31 CAW (CURRENT) * 02360020 * ********************************************** 02370020 SPACE 1 02380020 UCBTO DC 8X'00000000' TO DEVICE UCB 02390020 SPACE 1 02400020 UCBFRM DC 8X'00000000' FROM DEVICE UCB 02410020 SPACE 1 02420020 UCBSYI DC 8X'00000000' SYSTEM INPUT UCB 02430020 SPACE 1 02440020 UCBSYO DC 8X'00000000' SYSTEM OUTPUT UCB 02450020 SPACE 1 02460020 UCBOPR DC 8X'00000000' OPERATOR OUTPUT UCB 02470020 EJECT 02480020 * PSW AREAS 02490020 SPACE 2 02500020 SVPSW DS 1D USED BY INTERRUPT SUPERVISORS 02510020 SPACE 1 02520020 COWAIT DC X'00060000' TERMINATE WAIT STATE. 02530020 DC X'0000EEEE' 02540020 SPACE 1 02550020 COWAIT1 DC X'01060000' OPERATOR INTERVENTION WAIT. 02560020 DC X'00006666' 02570020 SPACE 1 02580020 WAITNO1 DC X'FF060000' WAIT PSW FOR OPR SYSIN INSERT 02590020 DC X'0000FFFF' 02600020 SPACE 1 02610020 WAITNO2 DC X'FF060000' WAIT PSW FOR CNTRL UNIT END. 02620020 DC A(STARTIO1) 02630020 SPACE 1 02640020 CONTINUE DC X'01040000' CONSOLE INTRPT RETURN PSW 02650020 DC A(CKINPUT) 02660020 SPACE 1 02670020 IOWAIT DC X'01060000' I/O WAIT AND RETRY PSW 02680020 DC X'00001111' 02690020 SPACE 02700020 * 02710020 * COMMON CONSTANTS 02720020 * 02730020 DS 0F 02740020 SYSBAS DC X'00001000' ****TEMPORARY 02750020 SYSBASE DC X'00002000' BASE VALUE 02760020 BUFRBAS DC X'00003000' BASE REGISTER FOR BUFFERS MSG. 02770020 ZERO DC XL8'00' DOUBLE WORD CONTAING ZEROS. 02780020 ERRORMSG DC A(ERRMSG) ADDRESS OF ERROR MESSAGE TABLE. 02790020 HUNIT DC A(UNITBUF+1) POINTER TO CONVERTED UNIT ADDRES 02800020 ADUCBOPR DC A(UCBOPR) ADDRESS OF LAST CONTROL BLOCK. 02810020 SAVELK9 DC F'0' LINK REGISTER SAVE FOR STARTIO. 02820020 SAVELK9A DC F'0' LINK REG SAVE AREA FOR STARTIO 02830020 SAVELK2 DC F'0' LINK REG SAVE AREA FOR ERRORS 02840020 EJECT 02850020 * SYSTEM REGISTER DESIGNATIONS 02860020 * 02870020 SCANADR EQU 1 SCAN ADR POINTER 02880020 LENGTH EQU 2 SCAN LENGTH REGISTER 02890020 BASE0 EQU 0 BASE REGESTER ZERO 02900020 ERREG1 EQU 1 02910020 ERREG3 EQU 3 02920020 CCWREG EQU 3 02930020 ERREG4 EQU 4 02940020 CSR1 EQU 1 02950020 CSR2 EQU 2 02960020 UCBREG EQU 2 POINTER TO UCB 02970020 CSR3 EQU 3 02980020 CSR4 EQU 4 02990020 WORK4 EQU 4 03000020 CSR5 EQU 5 03010020 GR1 EQU 1 03020020 GR2 EQU 2 03030020 GR3 EQU 3 03040020 GR4 EQU 4 03050020 REG1 EQU 1 03060020 GR5 EQU 5 03070020 GR9 EQU 9 03080020 GR6 EQU 6 03090020 GR7 EQU 7 03100020 GR8 EQU 8 03110020 GR15 EQU 15 03120020 LINK1 EQU 1 LINKAGE REGESTER 1 03130020 BASE10 EQU 10 SYSTEM BASE REG 03140020 BASE12 EQU 12 03150020 ERRLNK EQU 9 * 03160020 LINK5 EQU 5 03170020 LINK9 EQU 9 LINK REQISTER 03180020 LINK14 EQU 14 03190020 LINK15 EQU 15 03200020 REGD EQU 4 03210020 REGE EQU 5 03220020 REGF EQU 6 03230020 REGG EQU 7 03240020 EJECT 03250020 * *************************************************** 03260020 * * EQUATES FOR STANDARDS * 03270020 * *************************************************** 03280020 T1402 EQU X'18' 1402 DEVICE CODE S20201 03290020 T1442 EQU X'19' 1442 DEVICE CODE S20201 03300020 T2400 EQU X'08' 2400 DEVICE CODE S20201 03310020 T1052 EQU X'17' 1052 DEVICE CODE S20201 03320020 ZERR EQU 0 LENGTH OF ZERO S20201 03330020 ONE04 EQU 104 MESSAGE LENGTH S20201 03340020 T1403 EQU X'1A' 1403 DEVICE CODE S20201 03350020 T1443 EQU X'1B' 1443 DEVICE CODE S20201 03360020 L1 EQU 1 LENGTH OF ONE S20201 03370020 T2305 EQU X'06' 2305 DEVICE CODE S20201 03380020 MODBIT EQU X'00' MODEL BYTE S20201 03390020 FOX9 EQU X'F9' VALID CHAR CHECK S20201 03400020 ONE EQU X'F1' CHARACTER 1 S20201 03410020 TWO EQU X'F2' CHARACTER 2 S20201 03420020 ORONE EQU X'01' BINARY ONE S20201 03430020 ONETWO EQU 12 MVC COUNT S20201 03440020 TDASD EQU X'0B' MAX DIRECT ACCESS CODE S20201 03450020 L20 EQU 20 LENGTH OF 20 S20201 03460020 SKBIT EQU X'30' SKIP BIT ON S20201 03470020 T3330 EQU X'09' 3330 DEVICE CODE S20201 03480020 TEN EQU X'10' ENVIR. DATA BIT FOR 3330 S20201 03490020 TWOSIX EQU 26 LENGTH OF 26 S20201 03500020 EIGHTY EQU X'80' BUFLOG FULL SENSE BYTE S20201 03510020 L15 EQU 15 LENGTH OF 15 S20201 03520020 L3 EQU 3 LENGTH OF 3 S20201 03530020 L4 EQU 4 LENGTH OF 4 S20201 03540020 L5 EQU 5 LENGTH OF 5 S20201 03550020 L17 EQU 17 LENGTH OF 17 S20201 03560020 L18 EQU 18 LENGTH OF 18 S20201 03570020 L2 EQU 2 LENGTH OF 2 S20201 03580020 L6 EQU 6 LENGTH OF 6 S20201 03590020 L24 EQU 24 LENGTH OF 24 S20201 03600020 L12 EQU 12 LENGTH OF 12 S20201 03610020 L7 EQU 7 LENGTH OF 7 S20201 03620020 L16 EQU 16 LENGTH OF 16 03630020 L13 EQU 13 LENGTH OF 13 S20201 03640020 L8 EQU 8 LENGTH OF 8 S20201 03650020 L32 EQU 32 LENGTH OF 32 M3390 03655020 CHNGCYL EQU X'01' SET NEW SEEK ADDRESS S20201 03660020 CYLHI EQU X'40' IS CYLINDER HI BIT ON S20201 03670020 CNTFLD EQU X'10' COUNT CCW S20201 03680020 T23A5 EQU X'06' 2305-1 S20201 03690020 T23C5 EQU X'07' 2305-2 S20201 03700020 CMDTIC EQU X'08' TIC COMMAND CODE S20201 03710020 DCHAIN EQU X'80' DATA CHAIN BIT S20201 03720020 SLI EQU X'20' SLI BIT CHECK S20201 03730020 SKIP EQU X'10' SKIP BIT CHECK S20201 03740020 * *************************************************** 03750020 * * REGISTER EQUATES FOR ERROR CORRECTION FUNCTION * 03760020 * *************************************************** 03770020 ECFREG1 EQU 1 CCW ADDRESS PTR S20201 03780020 ECFREG2 EQU 15 ECC DATA POINTER M3390 03790020 ECFREG3 EQU 14 CCW POINTER S20201 03800020 ECFREG4 EQU 4 LOOP REGISTER S20201 03810020 ECFREG5 EQU 5 DISPLACEMENT PTR S20201 03820020 ECFREG6 EQU 6 DATA CHAIN REG S20201 03830020 EJECT 03840020 START LM 0,15,REGSV2 CLEAR GENERAL REGISTERS 03850020 L BASE10,SYSBAS ESTABLISH BASE REG 03860020 LM 12,13,SYSBASE ESTABLISH OTHER BASE REGISTERS 03870020 MVC 88(40),SETUPPSW ESTABLISH DUMP/RESTORE PSWS. 03880020 MVI 50,X'FF' SET SEREP FLAGS IN OLD MC PSW 03890020 MVI REQSW,X'00' TURN OFF REQUEST SWITCH 7674 03900020 LPSW WAITNO1 WAIT FOR SYSIN DEVICE DEFINITION 03910020 * 03920020 * SETUP SYSIN DEVICE FROM CONSOLE INPUT 03930020 * 03940020 CKINPUT TM INPUTDEV,X'F0' IS INPUT VIA READER 1402/2540 03950020 BC 8,IN1402 YES - PERFORM 1402 SETUP 03960020 MVZ CHCKAREA(1),INPUTDEV SETUP DEVICE TYPE CHECK 03970020 CLI CHCKAREA,X'10' IS SYSIN DEVICE A 1442 03980020 BC 8,IN1442 YES 03990020 CLI CHCKAREA,X'20' IS SYSIN DEVICE A 2400 04000020 BC 8,IN2400 YES 04010020 CLI CHCKAREA,X'30' IS SYSIN DEVICE A 1052 04020020 BC 8,IN1052 YES 04030020 CLI INPUTDEV,X'BA' WAS INTERRUPT KEY DEPRESSED. 04040020 BC 8,START YES--GO TO START UNTIL REQUEST. 04050020 B INPUTERR ILLEGAL INPUT DEVICE 04060020 * 04070020 IN1402 MVI UCBSYI,T1402 SETUP SYSIN UCB FOR 1402 S20201 04080020 INADR EQU * S20201 04090020 MVC UCBSYI+2(2),INPUTDEV ENTER SYSIN C/U IN SYSIN UCB 04100020 NI UCBSYI+2,X'07' CLEAR DEVICE TYPE INDICATOR 04110020 B CLRSCAN 04120020 * 04130020 IN1442 MVI UCBSYI,T1442 SETUP SYSIN UCB FOR 1442 S20201 04140020 B INADR ENTER SYSIN C/U IN UCBSYI 04150020 * 04160020 IN2400 MVI UCBSYI,T2400 SETUP SYSIN UCB FOR 2400 S20201 04170020 B INADR 04180020 * 04190020 IN1052 MVI UCBSYI,T1052 SETUP SYSIN UCB FOR 1052 S20201 04200020 B INADR 04210020 * 04220020 * INPUT PARAMETER ERROR DISPLAY ROUTINE 04230020 * 04240020 INPUTERR MVC WAITNO1+6(2),INPUTDEV SET INTERFACE ADR FOR DISPLAY 04250020 MVZ WAITNO1+6(1),CON80 INSERT CODE 8 IN FIRST HALF BYTE 04260020 * INDICATES INPUT PARAMETER ERROR 04270020 LPSW WAITNO1 SET WAIT CODE IN COLSOLE LIGHTS 04280020 * 04290020 DS 0F 04300020 CON80 DC X'80' 04310020 ENABLE DC X'FF' SSM ENABLE 04320020 DS 0H 4332 04330020 EJECT 04340020 * SETUP SYSIN DEVICE FROM TYPEWRITER INPUT 04350020 SPACE 2 04360020 ATTN TM REQSW,X'FF' IS THIS FIRST ATTN INTERUPT 7674 04370020 MVI REQSW,X'FF' TURN ON REQUEST SWITCH 7674 04380020 BO WAITREQ NOT FIRST. RETURN. 7674 04390020 ATTN1 SSM ENABLE SET SYSTEM MASK ENABLE 7674 04400021 MVI UCBOPR,T1052 UCBOPR DEVICE TYPE S20201 04410020 MVC UCBOPR+2(2),58 INSERT C/U IN UCBOPR 04420020 LA GR1,47 LENGTH OF MESSAGE IN BYTES 04430020 LA CSR2,OPRMSG MESSAGE PRINT WORD TO OPERATOR 04440020 BAL LINK15,OPPRNT CALL W T O ROUTINE 04450020 SPACE 1 04460020 LA UCBREG,UCBOPR GET TYPE WRITER UCB 04470020 LA CCWREG,TYPREAD GET READ CCW FOR TYPEWRITER 04480020 BAL LINK9,STARTIO ISSUE SIO 04490020 SPACE 1 04500020 OC SYIBUF+11(3),UPPRCASE CONVERT TO UPPER CASE 6379 04510020 SPACE 1 04520020 MSGANL MVC SYIMDL(4),SYIBUF+6 INSERT SYSIN MODEL NUMBER 04530020 MVC SYIDEV(3),SYIBUF+11 INSERT SYSIN DEVICE ADR 04540020 LA CSR2,SYIMDL CHECK SYSIN MODEL ENTRY 04550020 LA CSR3,SYINTAB TABLE LIMITS START ADR AND 04560020 LA CSR5,MODTAB-5 END ADR RESPECTIVELY 04570020 BAL LINK9,DEVLUP 04580020 SPACE 1 04590020 MVC UCBSYI(1),0(CSR3) SET SYSIN DEVICE TYPE CODE 04600020 CLI UCBSYI,T2400 IS SYSIN TAPE S20201 04610020 BNE MSGANL1 NO, SKIP MODE SET 04620020 MVI SYICCW,X'93' YES, MOVE MODE SET IN 04630020 MSGANL1 LA CSR2,SYIDEV CHECK SYSIN DEVICE ADR 04640020 BAL LINK9,INTFCECK CHECK INTERFACE ADR 04650020 SPACE 1 04660020 B INPUTERR ERROR ON SYSIN DEF ENTRY 04670020 SPACE 1 04680020 STH CSR1,UCBSYI+2 INSERT SYSIN C/U IN UCB 04690020 B CLRSCAN 04700020 SPACE 2 04710020 DS 0D 04720020 TYPREAD DC X'0A' TYPEWRITER READ CCW 04730020 DC AL3(SYIBUF) 04740020 DC X'2000000E' 04750020 SPACE 2 04760020 OPRMSG DC CL29'IBC105A DEFINE INPUT DEVICE. ' 6379 04770020 DC CL18'DUMP/RESTORE 7.7 ' CONSOLE MESSAGE S20201 04780021 EJECT 04790020 UPPRCASE DC XL3'404040' 6379 04800020 SYIBUF DC 28X'00' SAVE AREA FOR SEREP INFO. 04810020 * INPUT DEVICE DEFINITION AREA. 04820020 SEREPSAV EQU SYIBUF 04830020 EJECT 04840020 SPACE 3 04850020 * ********************************************** 04860020 * * DATA INPUT ROUTINE * 04870020 * ********************************************** 04880020 SPACE 3 04890020 * GR2 CONTINS THE INPUT BUFFER ADDRESS 04900020 SPACE 2 04910020 SYSIN STM 0,15,REGSV2 SAVE REGISTERS 04920020 ST GR2,SYICCW1 SET DATA ADDRESS IN CCW 04930020 MVI SYICCW1,X'02' SET READ COMMAND 04940020 LM GR2,GR3,INPUTR SET START IO PARAMETERS 04950020 BAL LINK9,STARTIO LINK TO START I/O 04960020 SPACE 1 04970020 LM 0,15,REGSV2 RESTORE REGISTER 04980020 BR LINK15 RETURN TO CALLER 04990020 SPACE 2 05000020 * CONSTANTS AND STORAGE AREAS FOR SYSTEM INPUT 05010020 SPACE 2 05020020 DS 0D 05030020 INPUTR DC A(UCBSYI) POINTER TO SYSIN UCB 05040020 DC A(SYICCW) CONTAINS CCW LIST FOR SYSIN 05050020 SPACE 1 05060020 SYICCW CCW 3,SYICCW,X'40',1 05070020 SYICCW1 DC F'0' 05080020 DC X'20000050' 05090020 EJECT 05100020 * ********************************************** 05110020 * * MESSAGE OUTPUT ROUTINE * 05120020 * ********************************************** 05130020 SPACE 2 05140020 SYSOUT STM 0,15,REGSV4 SAVE REGISTERS 05150020 CLI UCBSYO,X'00' IS OUTPUT DEVICE DEFINED 05160020 BC 7,SYSOUT1 YES - USE DEFINED OUTPUT DEVICE 05170020 CLI UCBOPR,X'00' NO - IS WTO DEVICE DEFINED 05180020 BC 7,OPPRNT YES-IS DEFINED. 05190020 LPSW COWAIT NO--SET WAIT. 05200020 SPACE 1 05210020 SYSOUT1 ST GR2,SYOCCW STORE MSG ADR IN CCW 05220020 CLI UCBSYO,T2400 IS SYSOUT TAPE S20201 05230020 BC 8,SYOTAPE YES - ADJUST CCW LIST FOR TAPE 05240020 SPACE 1 05250020 CLI UCBSYO,T1052 IS SYSOUT TYPEWRITER S20201 05260020 BC 8,SYOTYPE YES - ADJUST CCW LIST FOR TYPE 05270020 MVI SYOCCW,X'11' ASSUME DOUBLE SPACE 05280020 B SYSREF 05290020 SPACE 1 05300020 SYOTAPE MVI SYOCCW,X'01' SET TAPE WRITE OPR IN SYOCCW 05310020 LA UCBREG,UCBSYO ADDRESS OF SYSOUT UCB 05320020 LA CCWREG,SYOTCCW POINTER TO CCW LIST 05330020 B SYSREF1 05340020 SPACE 1 05350020 SYOTYPE MVI SYOCCW,X'09' SET TYPE WRITE CMD IN SYPCCW 05360020 ST CSR1,SYOCCW+4 INSERT COUNT IN CCW 05370020 MVI SYOCCW+4,X'20' SET CCW FLAG BYTE 05380020 SPACE 1 05390020 SYSREF LM GR2,GR3,OUTPUTR GET UCB AND CCW LIST ADR 05400020 SYSREF1 BAL LINK9,STARTIO ISSUE START I/O SEQUENCE. 05410020 LM 0,15,REGSV4 RESTORE REGISTERS 05420020 BR LINK15 RETURN TO CALLER 05430020 SPACE 2 05440020 * CONTAINS AND STORAGE AREAS FOR SYSOUT 05450020 SPACE 1 05460020 OUTPUTR DC A(UCBSYO) POINTER TO SYSOUT UCB 05470020 DC A(SYOCCW) ADR OF SYSOUT CCW LIST 05480020 SPACE 1 05490020 SYOTCCW CCW X'BB',ZERO,X'40',1 MODE SET ODD PARITY TRANSLATOR 05500020 * ON BYTE CONVERTER OFF 05510020 SYOCCW DC A(0) SYSOUT CCW 05520020 DC X'20000080' 131 CHARACTERS 05530020 EJECT 05540020 * ********************************************** 05550020 * * WRITE TO OPERATOR ROUTINE * 05560020 * ********************************************** 05570020 * 05580020 * GR1 CONTAINS NUMBER OF CHARACTER TO WRITE 05590020 * GR2 CONTAINS STARTING ADDRESS OF MESSAGE 05600020 * 05610020 SPACE 1 05620020 * SET UP CCW 05630020 SPACE 1 05640020 OPPRNT STM 0,15,REGSV6 SAVE REGISTERS 05650020 ST GR1,OPRCCW+4 STORE COUNT 05660020 ST GR2,OPRCCW STORE ADDRESS 05670020 MVI OPRCCW,X'09' WRITE COMMAND 05680020 MVI OPRCCW+4,X'20' SET SILI BIT 05690020 LM GR2,GR3,SYSOPR SPIOCS PARAMETERS 05700020 CLC UCBSYO+2(2),UCBOPR+2 IS SYSOUT UCB = OPER UCB 05710020 BNE OPPRN1 NO--CONTINUE 05720020 LA GR2,UCBSYO YES--POINT TO SYSOUT UCB 05730020 SPACE 1 05740020 * PRINT MESSAGE 05750020 SPACE 1 05760020 OPPRN1 BAL LINK9,STARTIO ISSUE SIO TO W T O 05770020 LM 0,15,REGSV6 RESTORE REGISTERS 05780020 BR LINK15 RETURN TO CALLER 05790020 SPACE 1 05800020 * CONSTANTS AND STORAGE AREA FOR OPPRNT 05810020 * 05820020 DS 0D 05830020 SYSOPR DC A(UCBOPR) POINTER TO TYPEWRITER UCB 05840020 DC A(OPRCCW) 05850020 OPRCCW DS 1D OPPRNT CCW 05860020 * 05870020 EJECT 05880020 * *********************************************** 05890020 * * I/O ERROR MESSAGE FORMAT ROUTINE * 05900020 * *********************************************** 05910020 * 05920020 IOPRNT STM 0,15,REGSV7 SAVE REGISTERS 05930020 MVI IOCONV,C' ' BLANK OUT IOCONV 05940020 MVC IOCONV+1(35),IOCONV 05950020 UNPK IOCONV(5),2(3,UCBREG) UNPACK CHANNEL / UNIT 05960020 UNPK IOCONV+4(5),20(3,UCBREG) UNPACK CSW STATUS FIELD 05970020 UNPK IOCONV+8(13),24(7,UCBREG) UNPACK SENSE INFORMATION 05980020 CLI ZERR(UCBREG),T2400 IS THIS TAPE S20201 05990020 BE NOTDASD NO- BYPASS CCHH PRINT S20201 06000020 CLI ZERR(UCBREG),TDASD IS THIS A DA DEVICE S20201 06010020 BH NOTDASD NO--BYPASS PRINT OF CCHH. 06020020 L CSR4,4(UCBREG) YES-POINTER TO CCW LIST. 06030020 LTR CSR4,CSR4 IS THERE A POINTER TO A CCW LIST 06040020 BC 8,NOTDASD NO--DO NOT PRINT CCHH. 06050020 L CSR4,0(CSR4) POINTER TO SEEK ADDRESS. 06060020 UNPK IOCONV+24(9),2(5,CSR4) UNPACK THE SEEK ADDRESS. 06070020 NOTDASD OC 16(4,UCBREG),16(UCBREG) COMMAND CODE FROM CSW OR CAW? 06080020 BC 4,CSWEXIT CSW--GO TO CSWEXIT. 06090020 SPACE 1 06100020 L CSR4,4(UCBREG) CAW--GET COMMAND CODE FROM CAW. 06110020 B CAWEXIT GO TO CAW EXIT . 06120020 SPACE 1 06130020 CSWEXIT L CSR4,16(UCBREG) GET ADDRESS IN CSW AT INTERRUPT. 06140020 S CSR4,EIGHT GET ADDRESS OF CCW THAT INTERPTD 06150020 SPACE 1 06160020 CAWEXIT UNPK IOCONV+20(3),0(2,CSR4) UNPACK COMMAND CODE TO PRINT 06170020 TR IOCONV(32),IOTAB-240 TRANSLATE TO EBCDIC. 06180020 L WORK4,ERRORMSG PUT ADDRESS OF ERRMSG IN REG 4 06190020 AR WORK4,ERREG1 ADD VALUE OF ERREG1 TO REG. 4 06200020 MVI PRWD,C' ' CLEAR PRINT AREA BEFORE 8407 06210020 MVC PRWD+1(131),PRWD INSERTING MESSAGE. 8407 06220020 MVC PRWD(4),IBC2 INSERT MSG HEADER S20201 06230020 MVC PRWD+4(20),0(WORK4) INSERT INDEXED MSG S20201 06240020 MVC PRWD+26(3),IOCONV+1 INSERT CHANNEL/UNIT IN MSG 06250020 MVC PRWD+30(2),IOCONV+20 INSERT OP CODE IN MSG 06260020 MVC PRWD+33(4),IOCONV+4 INSERT CSW STATUS IN MSG 06270020 MVC PRWD+38(12),IOCONV+8 INSERT SENSE INFORMATION 06280020 MVC PRWD+52(8),IOCONV+24 MOVE IN SEEK ADDRESS IF ANY. 06290020 BAL GR15,MORSENSE CHECK IF DIRECT ACCESS S20201 06300020 LM 0,15,REGSV7 RESTORE REGS 06310020 LA CSR1,ONE04 MESSAGE LENGTH S20201 06320020 * 06330020 * *********************************************** 06340020 * * WRITE A LINE TO MSG OUTPUT * 06350020 * *********************************************** 06360020 * 06370020 PRNT STM 0,15,REGSV7 SAVE REGISTERS 06380020 LA GR2,PRWD 132 BYTE WORD TO BE PRINTED 06390020 BAL GR15,CHKMSG CHECK FOR VALID MSG S20201 06400020 BAL GR15,SYSOUT PRINT ONE LINE 06410020 MVI PRWD,C' ' CLEAR PRINT AREA TO BLANKS 06420020 MVC PRWD+1(131),PRWD 06430020 LM 0,15,REGSV7 RESTORE REGS 06440020 BR LINK9 RETURN TO CALLING ROUTINE 06450020 SPACE 1 06460020 DS 0D 06470020 PRWD DC 132C' ' MESSAGE PRINT BUFFER 06480020 EJECT 06490020 * *********************************************** 06500020 * * INPUT/OUTPUT CONTROL ROUTINE * 06510020 * * * 06520020 * * REG 2 POINTS TO UCB, REG 3 TO CCW LIST * 06530020 * *********************************************** 06540020 * 06550020 STARTIO1 SSM DISABLE MASK OFF INTERRUPTS 6379 06560020 STM 0,15,REGSIO SAVE THE REGISTERS 6379 06570020 STARTIOX L BASE10,SYSBAS ESTABLISH BASE REGISTER 06580020 LH CSR4,2(UCBREG) ENTER C/U INTO CSR4 06590020 STH CSR3,30(UCBREG) SAVE THE CAW. 06600020 ST CSR3,72 SET CCW ADDRESS IN CAW. 06610020 TIO 0(CSR4) CHECK STATUS. 06620020 TM 68,X'50' IS THE CONTROL UNIT BUSY. 06630020 MVI 68,X'00' CLEAR STATUS. 06640020 BC 1,WAITA2 YES--WAIT UNTIL AVAILABLE 06650020 SPACE 1 06652000 SIO LA CSR2,0(0,UCBREG) LOAD CURRENT UCB DEV ADDR A50281 06654021 LA GR8,UCBFRM LOAD UCB ADDR - FROM DEV A50281 06658000 CR GR8,CSR2 COMPARE REGISTERS A50281 06658400 BNE NOFAIL NO - NOT THE FROM DEVICE A50281 06658800 CLI 40(RCAW),X'1D' IS CCW COMMAND A WRITE A50281 06659621 BE INVLDADR YES TRAP IT - ISSUE ERROR A50281 06659700 SPACE 1 06660020 NOFAIL SIO 0(CSR4) ISSUE I/O COMMAND. 06670000 BC 8,IORTRN1 I/O STARTED//RETURN TO PROCESS. 06680020 BC 2,WAITA2 CHANNEL//SUBCHANNEL BUSY. 06690020 BC 1,SIOERR UNIT NOT AVAILABLE//TERMINATE. 06700020 B TIO3 06710020 SPACE 1 06720020 IORTRN1 MVI 1(UCBREG),X'FF' INDICATE IO STARTED. 06730020 TM ERRETRY,X'FF' ARE WE PROCESSING AN ERROR. 06740020 BC 1,TIO YES-GO CHECK STATUS OF DEVICE. 06750020 LM 0,15,REGSIO RESTORE THE REGISTERS. 06760020 SSM ENABLE NO,ALLOW INTERRUPTS 06770020 BR LINK9 RETURN TO CALLING ROUTINE. 06780020 SPACE 1 06790020 WAITA2 L CSR4,REGSIO+16 RESTORE REGISTER 4 06800020 LPSW WAITNO2 06810020 SPACE 1 06820020 DISABLE DC X'01' I/O DISABLED. 06830020 ERRETRY DC X'00' 06840020 R0SWITCH DC X'00' HA-R0 ONLY SWITCH. 06850020 RETRYDEV DS F ADDRESS OF UCB USING A22281 06860020 * DIRECT RETURN A22281 06870020 SPACE 1 06880020 IOTAB DC C'0123456789ABCDEF' 06890020 SPACE 1 06900020 IOCONV DC 18H'0' 06910020 EJECT 06920020 * ********************************************** 06930020 * * ALL I/O INTERRUPTS ENTER HERE * 06940020 * ********************************************** 06950020 SPACE 1 06960020 * CHECK FOR I/O ERROR 06970020 SPACE 1 06980020 CKCSW STM 0,15,REGSV5 SAVE THE REGISTERS. 06990020 MVC RESIDCNT(2),70 SAVE RESIDUAL CNT S20201 07000020 TM 68,X'80' THIS AN ATTENTION INTERRUPT. 07010020 BC 1,ATTN YES-SETUP TO HONOR REQUEST. 07020020 LA GR2,UCBTO ADDRESS OF FIRST UCB. 07030020 TESTERR CLI 1(GR2),X'FF' WAS I/O STARTED. 2711 07040020 BNE TRYNXT NO, TRY NEXT UCB. 2711 07050020 CLC 58(2,0),2(GR2) WAS INTRPT FOR THIS DEVICE.2711 07060020 BE FOUND YES- HAVE FOUND THE DEVICE. 07070020 TRYNXT LA GR2,32(GR2) ADDR OF NEXT CONTROL BLOCK.2711 07080020 CL GR2,ADUCBOPR ARE THERE MORE CONTROL BLOCKS. 07090020 BNH TESTERR RETURN TO FIND CORRECT DEVICE. 07100020 CLI REQSW,X'00' HAS INPUT DEV BEEN ASSIGNED.7674 07110020 BE START NO. WAIT FOR INPUT DEVICE. 4332 07120020 SPACE 1 07130020 WAITA3 MVI 57,X'04' INSURE WAIT STATE IS CLEAR. 7674 07140020 WAITREQ LM 0,15,REGSV5 RESTORE THE REGISTERS. 7674 07150020 LPSW 56 CONTINUE PROCESSING. 07160020 FOUND TM ACTXIISW,X'10' DIRECT RETURN BIT ON A22281 07170020 BC 1,DIRCTRTN YES, CHECK FOR I/O A22281 07180020 * COMPLETE A22281 07190020 CHKERR TM 68,X'03' NO,UNIT CHECK OR EXCP A22281 07200020 BC 5,IOERR YES 07210020 TM 69,X'FF' ANY ERROR BITS ON 07220020 BC 5,IOERR YES 07230020 TM 68,X'04' WAS THIS DEVICE END. 07240020 BC 8,WAITA3 NO--RETURN. 07250020 MVC 16(8,UCBREG),64 SAVE THE CSW. 07260020 IORTRN NI 1(UCBREG),X'00' YES--POST COMPLETE. 07270020 B WAITA3 RETURN TO PROCESS. 07280020 DIRCTRTN C UCBREG,RETRYDEV INTERRUPT FROM DEV A22281 07290020 * AWAITING A22281 07300020 * DIRECT RETURN A22281 07310020 BNE CHKERR NO, TREAT AS NORMAL A22281 07320020 * INTERRUPT A22281 07330020 TM 68,X'87' YES, TEST ALL A22281 07340020 * POSSIBILITIES A22281 07350020 BC 5,IORTRN INDICATING I/O IS A22281 07360020 TM 69,X'FF' COMPLETE, IF A22281 07370020 BC 5,IORTRN COMPLETE RETURN A22281 07380020 TIO 0(UCBREG) WAIT FOR I/O A22281 07390020 B DIRCTRTN TO COMPLETE A22281 07400020 IOERR MVC 8(16,UCBREG),56 SAVE I/O PSW AND CSW IN UCB 07410020 MVC 24(6,UCBREG),CLEAR CLEAR SENSE FIELD OF UCB. 07420020 L BASE10,SYSBAS ESTABLISH BASE REGISTER AGAIN 07430020 TM 68,X'02' IS THIS A UNIT CHECK. 07440020 BC 8,SAVEINT NO-CHECK DEV INTERRUPTING 07450021 LA CSR4,SENCCW SENSE CCW ADDRESS. 07460020 ST CSR4,72 SET UP THE CAW. 07470020 LH CSR4,2(UCBREG) CHANNEL//UNIT ADDRESS. 07480020 SENCHK SIO 0(CSR4) ISSUE SENSE COMMAND. 07490020 BC 3,SIOERR UNIT NOT OPERATIONAL. 07500020 BC 8,IOTIO SENSE OK//AWAIT COMPLETION. 07510020 CKSTAT TM 68,X'02' WAS THERE AN ERROR ON SENSE. 07520020 BC 1,EQUIPCHK YES--GIVE MESSAGE//TERMINATE. 07530020 B SENCHK REPEAT SENSE UNTIL ACCEPTED. 07540020 IOTIO TIO 0(CSR4) TEST STATUS OF DEVICE. 07550020 BC 2,IOTIO BUSY--TRY AGAIN. 07560020 MVC 24(6,UCBREG),IOSESV MOVE SENSE BYTES TO UCB. 07570020 * CHECK DEVICE TYPE INTERRUPTING 07580020 SPACE 2 07590020 TYPECHK TM ERRETRY,X'FF' IS THE ERROR RETRY SWITCH ON. 07600020 BC 1,ERBYPASS DO NOT SAVE ANYTHING 07610020 MVI ERRETRY,X'FF' TURN ON ERROR RETRY SWITCH. 07620020 SAVEINT TM DSKEOFSW,X'FF' IS DISK EOF SWITCH ON 5434 07630020 BC 1,ERBYPASS YES--DO NOT SAVE ANYTHING 5434 07640020 MVC SAVEPSW(8),56 RETURN PSW AFTER ERROR OK. 5434 07650020 MVC 6(2,UCBREG),30(UCBREG) SAVE ORIGINAL CAW. 07660020 MVC ERRSAV1(64),REGSV5 SAVE INTERRUPT REGISTERS. 07670020 SPACE 1 07680020 ERBYPASS CLI ZERR(UCBREG),T2400 2400 INTERRUPT S20201 07690020 BE ERR300 2400 ERROR ROUTINE S20201 07700020 SPACE 1 07710020 CLI ZERR(UCBREG),TDASD DASD INTERRUPT S20201 07720020 BNH ERR100 BR TO DA ERROR ROUTINE S20201 07730020 SPACE 1 07740020 CLI ZERR(UCBREG),T1052 1052 INTERRUPT S20201 07750020 BC 8,ERR500 07760020 SPACE 1 07770020 CLI ZERR(UCBREG),T1402 1402 INTERRUPT S20201 07780020 BE ERR200 1402 ERROR ROUTINE S20201 07790020 SPACE 1 07800020 CLI ZERR(UCBREG),T1442 1442 INTERRUPT S20201 07810020 BC 8,ERR200 07820020 SPACE 1 07830020 CLI ZERR(UCBREG),T1403 1403 INTERRUPT S20201 07840020 BC 8,ERR400 07850020 SPACE 1 07860020 CLI ZERR(UCBREG),T1443 1443 INTERRUPT S20201 07870020 BE ERR400 1403 ERROR ROUTINE S20201 07880020 SPACE 1 07890020 B SIOERR NO DEVICE TYPE IN TABLE. 07900020 SPACE 1 07910020 STARTIO SSM DISABLE MASK OFF INTERRUPTS 6379 07920020 TM ERRETRY,X'FF' IS THE ERROR RETRY SWITCH ON6379 07930020 BC 1,ERRLINK YES, STORE IN ERROR LINK SLOT 07940020 ST LINK9,SAVELK9 NO, SAVE THE LINK REGISTER 07950020 B STARTIN GO TO START I/O 07960020 ERRLINK ST LINK9,SAVELK9A SAVE THE ERROR LINK REGISTER 07970020 ST UCBREG,RETRYDEV SAVE ADDR OF UCB A22281 07980020 * EXPECTING A22281 07990020 * DIRECT RETURN A22281 08000020 STARTIN BAL LINK9,STARTIO1 GO TO START THE I/O. 08010020 SPACE 08020020 TESTIO CLI 1(UCBREG),X'FF' IS THE OPERATION COMPLETE. 08030020 BE TESTIO NO//AWAIT COMPLETION 08040020 SPACE 08050020 TESTIORT TM ERRETRY,X'FF' IS THE ERROR RETRY SWITCH ON 08060020 BC 1,ERRLOAD YES,GET ERROR LINK REGISTER 08070020 L LINK9,SAVELK9 RESTORE THE LINK REGISTER 08080020 BR LINK9 RETURN 08090020 SPACE 08100020 ERRLOAD L LINK9,SAVELK9A RESTORE THE ERROR LINK REGISTER 08110020 BR LINK9 RETURN 08120020 SPACE 08130020 TIO TIO 0(CSR4) CHECK STATUS OF DEVICE. 08140020 BC 2,TIO CHANNEL OR SUB-CHANNEL BUSY. 08150020 TM ACTXIISW,X'10' IS THE DIRECT RETURN BIT ON. 08160020 BC 1,TIO6 YES, TEST FOR I/O A22281 08170020 * COMPLETE A22281 08180020 SPACE 08190020 TIO3 TM 68,X'03' UNIT CHECK OR UNIT EXCEPTION. 08200020 BC 5,TIO2 YES-GO PROCESS. 08210020 TM 69,X'FF' ADDITIONAL ERROR FLAGS. 08220020 BC 5,TIO2 YES-GO PROCESS. 08230020 TM 68,X'04' DEVICE END 08240020 BC 8,TIO1 NO-CHECK OTHER POSSIBILITIES. 08250020 SPACE 08260020 TIO4 MVI 1(UCBREG),X'00' YES--POST COMPLETE. 08270020 LM 0,15,REGSIO RESTORE THE REGISTERS. 08280020 B TESTIORT TAKE NORMAL RETURN. 08290020 SPACE 08300020 TIO1 TM 68,X'30' CONTROL UNIT END. 08310020 BC 5,SIO YES--REISSUE THE SIO. 08320020 TM 68,X'08' CHANNEL END 08330020 BC 1,TIO LOOP ON TIO. 08340020 SPACE 08350020 TIO2 MVC REGSV5(64),REGSIO INSURE PROPER REGS SAVED. 08360020 * WHEN I/O ERROR IS HANDLED BY TIO THE LINK ADDRESS A23657 08370020 * MUST BE SAVED IN THE I/O PSW BECAUSE UPON A23657 08380020 * RECOVERING FROM THE ERROR THE PROGRAM RETURNS BY A23657 08390020 * LOADING THE I/O OLD PSW A23657 08400020 TM ERRETRY,X'FF' IS ERROR RETRY ON A23657 08410020 BC 1,TIO5 YES A23657 08420020 MVC 62(2,0),SAVELK9+2 NO, SAVE LNK ADR A23657 08430020 B IOERR GO HANDLE I/O ERROR A23657 08440020 TIO5 MVC 62(2,0),SAVELK9A+2 SAVE ADR IN I/O PSW A23657 08450020 B IOERR GO PROCESS ERROR. 08460020 TIO6 EQU * A22281 08470020 TM 68,X'87' TEST ALL BITS A22281 08480020 BC 5,TIO4 WHICH WOULD A22281 08490020 TM 69,X'FF' INDICATE I/O A22281 08500020 BC 5,TIO4 IS COMPLETE A22281 08510020 TIO 0(CSR4) WAIT FOR I/O TO END A22281 08520020 B TIO6 RETEST STATUS BYTES A22281 08530020 EJECT 08540020 CONTAB DS 0D CTL STATM CONDENSED INFO 08550020 SYOMDL DC XL4'0' 08560020 SYODEV DC XL4'0' 08570020 SYIMDL DC XL4'0' 08580020 SYIDEV DC XL4'0' 08590020 FMODEL DC XL4'0' 08600020 FMDEV DC XL4'0' 08610020 TOMDL DC XL4'0' 08620020 TODEV DC XL4'0' 08630020 MMOD DC XL4'0' MODEL BYTE S20201 08640020 RESIDCNT DC H'0' RESIDUAL COUNT AREA S20201 08650020 EJECT 08660020 * THIS ROUTINE CHECKS TO SEE IF THE LAST RESTORE WENT TO 4332 08670020 * A PROPER COMPLETION. IF NOT THE ALTERNATE TRACK INFORMATION 4332 08680020 * WILL BE CORRECTED. 4332 08690020 SPACE 2 4332 08700020 GR0 EQU 0 4332 08710020 SPACE 1 4332 08720020 ALTCKRTN STM GR15,GR0,ALTWORK SAVE TWO REGS. 4332 08730020 MVC ALTWORK+8(4),CCHH SAVE CCHH FIELD. 4332 08740020 L GR15,ALTDATA SET UP GR15 FOR CNGCYLT RTN.4332 08750020 LH GR0,ALTDATA+4 NUMBER OF ALTERNATES LEFT. 4332 08760020 ALTLOOP BCTR GR0,0 DECREMENT BY ONE. 4332 08770020 ST GR15,CCHH SET UP CCHH FOR CNGCYLT RTN.4332 08780020 CL GR15,CCHHALT COMPARE STATUS OF FORMAT 4. 4332 08790020 BH ALTRTRN A.O.K. 4332 08800020 BE ALTENDUP THE PREVIOUS RESTORE FAILED.4332 08810020 BAL RLINK1,CNGCYLT ADD ONE TRACK. 4332 08820020 B ALTLOOP LOOP UNTIL EQUAL. 4332 08830020 SPACE 1 4332 08840020 ALTENDUP BAL RLINK1,CNGCYLT ADD ONE TRACK. 4332 08850020 ST GR15,ALTDATA UPDATE NEXT ALAILABLE ALT. 4332 08860020 STH GR0,ALTDATA+4 UPDATE NO. OF AVAILABLE TKS.4332 08870020 ALTRTRN LM GR15,GR0,ALTWORK RESTORE TWO REGS. 4332 08880020 MVC CCHH(4),ALTWORK+8 RESTORE CCHH. 4332 08890020 B CONTINU RETURN. 4332 08900020 XSTARTD1 DC A(TOTAPE) 08910020 DC A(TO2311) 08920020 DC A(TO2314) 08930020 DC A(TO3330) DUMP TO 3330 S20201 08940020 XSTARTR1 DC A(FRMTAPE) 08950020 DC A(FRM2311) 08960020 DC A(FRM2314) 08970020 DC A(FR3330) RESTORE FROM 3330 S20201 08980020 EJECT 08990020 SPACE 1 09000020 * CONTROL DATA 09010020 DS 0D 09020020 SPACE 1 09030020 MASKOPCD DC X'00FFFFFF' MASK OFF CCW PO CODE 09040020 SPACE 1 09050020 MSKFLGON DC X'60000000' SET CHAIN C AND SILI BITS ON 09060020 SPACE 1 09070020 F1 DC F'1' 09080020 STC2321 DC X'0000FB00' 09090020 SCC2321 DC X'00F60000' 09100020 SPACE 1 09110020 ZERO1 EQU MSKFLGON+2 HALFWORD OF ZEROS 09120020 SPACE 1 09130020 ADTALENG DC A(DTALENG) 09140020 SPACE 1 09150020 ADMP2302 DC A(DMP2302) 09160020 SPACE 1 09170020 MSKFLGOF DC X'0000FFFF' SAVE COUNT FIELD 09180020 SPACE 1 09190020 MOVECHAR MVC 0(1,RWRKREG6),0(RWRKREG5) 09200020 SPACE 1 09210020 DS 0F 09220020 SPACE 1 09230020 TOTLTRK DC X'00C70001' 2311 TOTAL NUMBER OF USABLE TRACKS 09240020 CYLINCR1 DC X'0000FFF7' 2311 CHANGE CYL-TO DEV. TRANS DASD 09250020 TRECCNT DC X'0D30' 2311 MAX NO OF BYTES - 2 RECORDS 09260020 BUMPCYL DC X'0009' 2311 MAX TRACKS MINUS ONE. 09270020 SPACE 1 09280020 TOTLTRK1 DC X'00C7000E' 2314 TOT. NO. OF TRKS S20201 09290020 DC X'0000FFED' 2314 CHANGE CYLINDER S20201 09300020 DC H'7100' 2314 MAX BYTES 2/RCDS S20201 09310020 BUMPCYL1 DC X'0013' 2314 MAX TRKS-1 S20201 09320020 TOTLTRK2 DC X'01930012' 3330 TOT NO. USABLE TRKS S20201 09330020 DC X'0000FFEE' 3330 CHANGE CYLINDER S20201 09340020 DC X'3304' 3330 MAX BYTES 2/RCDS S20201 09350020 BUMPCYL2 DC X'0012' 3330 MAX TRKS MINUS 1 S20201 09360020 CORE DC 4X'00' USED IN COMPUTING SIZE OF DATA.4332 09370020 SPACE 1 09380020 FIVE12 DC H'512' 09390020 SPACE 1 09400020 AWAIT DC AL3(FIXEX) 09410020 EJECT 09420020 ORG0300X EQU * 5274 09430020 ORG ENTER+2968 5274 09440020 ORG0400 EQU * 5274 09450020 CLEARV3 DC XL8'00' POINTED TO BY ERASE CCW VERS. 3. 09460020 MORSENSE CLI ZERR(UCBREG),T2400 IS DEVICE A TAPE S20201 09470020 BE GETREST YES- GET MORE SENSE M1828 09480000 CLI ZERR(UCBREG),TDASD IS DEVICE DIRECT ACCESS S20201 09490020 BH PRINTIT NO - NO MORE SENSE INFO S20201 09500020 MVC PRWD96(L8),IOCONV24 MOVE SEEK ADDRESS S20201 09510020 GETREST UNPK IOCONV8(L13),IOSESV6(L7) GET SENSE BYTES 6-11 M1828 09520000 MVC PRWD52(L12),IOCONV8 MOVE SENSE BYTES 6-11 S20201 09530020 UNPK IOCONV8(L13),IOSESV12(L7) GET SENSE BYTES 12-17 S20201 09540020 MVC PRWD66(L12),IOCONV8 MOVE SENSE BYTES 12-17 S20201 09550020 BAL LINK9,PRINTIT1 GET MORE SENSE BYTES S20201 09560020 PRINTIT BR GR15 RETURN TO PRINT MSG S20201 09570020 SPACE 1 09580020 ALTWORK DS 3F (1) GR15, (2) GR0, (3) CCHH.4332 09590020 ALTDATA DS 3H ALTDATA MUST BE ON WD.BNDRY.4332 09600020 EXTINT1 LPSW 24 RETURN TO INTRPT POINT 5274 09610020 SPACE 1 09620020 ORG0400X EQU * 5274 09630020 ORG ENTER+3056 5274 09640020 ORG0500 EQU * 5274 09650020 CLEAR DC XL8'00' POSITION DEPENDENT FOR VERSION 4 09660020 PRINTIT1 UNPK IOCONV8(L13),IOSESV18(L7) GET SENSE BYTES 18-23 S20201 09670020 MVC PRWD80(L12),IOCONV8 MOVE SENSE BYTES 18-23 S20201 09680020 XC IOSESV(L24),IOSESV BLANK OUT SENSE AREA S20201 09690020 BR LINK9 BR TO RETURN TO CALLER S20201 09700020 CHKMSG SR GR3,GR3 ZERO OUT WORK REG S20201 09710020 LA GR2,PRWD GET MSG START ADDR S20201 09720020 LR GR8,CSR1 SAVE MESSAGE LENGTH SA58009 09722021 CHKMSG1 CLI 0(GR2),FOX9 CHECK FOR VALID CHAR S20201 09730020 BNH NXTBYTE VALID, BYPASS CORRECTION S20201 09740020 IC GR3,0(GR2) GET BAD CHARACTER S20201 09750020 BCTR GR3,0 DECREMENT BY ONE S20201 09760020 N GR3,NCHAR MAKE INTO VALID CHAR S20201 09770020 STC GR3,0(GR2) STORE VALID CHAR S20201 09780020 NXTBYTE LA GR2,1(GR2) GET NEXT BYTE S20201 09790020 BCT CSR1,CHKMSG1 REPEAT LOOP S20201 09800020 LR CSR1,GR8 RESET MSG ADDRESS SA58009 09810021 LA GR2,PRWD GET MESSAGE ADDR S20201 09820020 BR GR15 RETURN TO CALLER S20201 09830020 IBC2 DC C'IBC2' MESSAGE HEADER S20201 09840020 DS 0F S20201 09850020 NCHAR DC X'FFFFFFC7' CHANGE TO PRINTABLE S20201 09860020 IOSESV DC 24X'00' SENSE BYTES READ IN AREA S20201 09870020 SENCCW CCW X'04',IOSESV,X'20',24 SENSE COMMAND S20201 09880020 SAVLGTH DS 1F SCAN LENGTH REG SAVE AREA 09890020 MODSAV DS 10F 1ST HALF OF MESSAGE SAVE AREA. 09900020 * THE FOLLOWING 40 BYTES ALSO USED FOR MESSAGE SAVE AREA. 09910020 SETUPPSW DC X'01040000' NEW EXTERNAL INTERRUPT PSW. 09920020 DC A(EXTINT) 09930020 SPACE 1 09940020 DC X'01040000' NEW SUPERVISOR CALL PSW. 09950020 DC A(SVCINT) 09960020 SPACE 1 09970020 DC X'01040000' NEW PROGRAM INTERRUPT PSW. 09980020 DC A(PGMINT) 09990020 SPACE 1 10000020 DC X'00020000' MACHINE CHECK PSW. 10010020 DC X'000000E2' 10020020 SPACE 1 10030020 DC X'01040000' NEW I/O PSW. 10040020 DC A(CKCSW) 10050020 CVBCOM DS 1D CVB WORK AREA. 10060020 R0DATA DC 1D'0' 10070020 SWITCHRD DS 29F CARD READ IN AREA. 10080020 BGNADR DC F'0' 10090020 ENDADR DC F'0' 10100020 ENDADRX DC 3H'0' 10110020 SARG DS 1D SEARCH ARGUMENT 10120020 VOLLBL1 DC 6C' ' 10130020 VOLLABEL DC 42C' ' TODEV VOL LABELS SAVE 10140020 SIXX DC F'6' 10150020 SEQSW DC X'00' CTL STM SEQUENCE INDICATOR SW 10160020 JOBSW DC X'FF' JOB STM PRINT INDICATOR 10170020 ENDSW DC X'00' VDRL END ADDRESS SWITCH 10180020 CHANSAV DC X'00' CHANNEL NUMBER SAVE AREA 10190020 NORCDSW DC X'00' USED BY LABEL CHECK RTN. 10200020 ACTXIISW DC X'00' 10210020 NON2311 DC X'00' UNLIKE DASD SWITCH 10220020 FULLDPSW DC X'00' 10230020 MODESW DC X'00' SET TO '0F' IF MODE GIVEN 10240020 MODESET DC H'00' USER MODE SETTING 10250020 CHCKAREA DC X'00' DEVICE CHECK SAVE AREA. 10260020 EOJSW DC X'00' USED TO INDICATE EMD OF JOB. 10270020 EORSW DC X'00' USED TO INDICATE END OF REEL5274 10280020 REQSW DC X'00' 1ST TIME SWITCH FOR REQUEST 7674 10290020 SPACE 2 10300020 IOSESV18 EQU IOSESV+18 SENSE BYTE AREA +18 S20201 10310020 PRWD66 EQU PRWD+66 OUTPUT AREA +66 S20201 10320020 IOSESV12 EQU IOSESV+12 SENSE BYTE AREA +12 S20201 10330020 PRWD52 EQU PRWD+52 OUTPUT AREA +52 S20201 10340020 IOSESV6 EQU IOSESV+6 SENSE BYTE AREA S20201 10350020 IOCONV8 EQU IOCONV+8 ADDR OF UNPK AREA+8 S20201 10360020 IOCONV24 EQU IOCONV+24 ADDR OF UNPK AREA+24 S20201 10370020 PRWD96 EQU PRWD+96 OUTPUT AREA +96 S20201 10380020 PRWD80 EQU PRWD+80 OUTPUT AREA +80 S20201 10390020 EJECT 10400020 * ********************************************************* 10410020 * * COMMON I/O STATUS & SENSE BIT ERROR INTERPRET ROUTINE * 10420020 * ********************************************************* 10430020 SPACE 3 10440020 NEXTBIT LA ERRLNK,2(ERRLNK) ADDR. OF NEXT STATUS/SENSE BIT. 10450020 SPACE 1 10460020 ERRTEST SR ERREG1,ERREG1 ZERO REGISTER---NORMAL ENTRY--- 10470020 IC ERREG1,0(ERRLNK) GET SENSE OR STATUS CODE BIT 10480020 TM 0(ERRLNK),STATMASK IS STATUS BYTES TO BE TESTED ? 10490020 BC 1,STATTEST YES--GO TO STATUS TEST ROUTINE. 10500020 LH ERREG4,24(UCBREG) NO--GET 2 SENSE BYTES FROM UCB. 10510020 SPACE 1 10520020 SHIFTBIT LNR ERREG1,ERREG1 COMPLMT CODE BIT/GET SHIFT FACTR 10530020 LA ERREG3,1 INITIATE REG TO 1 10540020 SLA ERREG3,15(ERREG1) SHIFT TO FIND POSITION OF BIT 10550020 BC 1,ERREND END OF TEST 10560020 NR ERREG3,ERREG4 TEST IF CODE BIT IS ON 10570020 BC 8,NEXTBIT NO, GET THE NEXT BIT 10580020 SPACE 1 10590020 ERREND SR ERREG1,ERREG1 ZERO REGISTER 10600020 IC ERREG1,1(ERRLNK) GET DISPLACEMENT 10610020 BC 15,0(ERREG1,ERRLNK) BRANCH TO PROPER ROUTINE 10620020 SPACE 1 10630020 STATTEST LH ERREG4,20(UCBREG) GET 2 STATUS BYTES FROM UCB. 10640020 N ERREG1,STATZERO ZERO STATUS CODE BIT 10650020 BC 15,SHIFTBIT BR-CHECK STATUS BITS 10660020 SPACE 3 10670020 DS 0F 10680020 STATZERO DC X'0000000F' 10690020 STATMASK EQU X'10' '10' INDICATES A STATUS BYTE 10700020 EJECT 10710020 * ************************************************************ 10720020 * * FOLLOWING ROUTINES ARE USED BY ALL DASD DEVICES* 10730020 * ************************************************************ 10740020 SPACE 2 10750020 * DASD TEST CHANNEL STATUS BYTES ROUTINE. 10760020 SPACE 2 10770020 ERR100 BAL ERRLNK,ERRTEST LINK TO STATUS/SENSE BYTES TEST. 10780020 DC X'1D' CHANNEL CONTROL CHECK 10790020 DC AL1(ERR101-ERR100-4) 10800020 DC X'1E' INTERFACE CONTROL CHECK 10810020 DC AL1(ERR102-ERR100-6) 10820020 DC X'1C' CHANNEL DATA CHECK 10830020 DC AL1(ERR103-ERR100-8) 10840020 DC X'10' SHOULD NOT OCCUR 10850020 DC AL1(ERR104-ERR100-10) 10860020 DC X'16' UNIT CHECK 10870020 DC AL1(ERR130A-ERR100-12) 10880020 DC X'1F' CHAINING CHECK 10890020 DC AL1(ERR105-ERR100-14) 10900020 DC X'1A' PROGRAM CHECK 10910020 DC AL1(ERR106-ERR100-16) 10920020 DC X'1B' PROTECTION CHECK 10930020 DC AL1(ERR107-ERR100-18) 10940020 DC X'17' UNIT EXCEPTION 10950020 DC AL1(ERR108-ERR100-20) 10960020 DC X'19' INCORRECT LENGTH 10970020 DC AL1(ERR109-ERR100-22) 10980020 DC X'2F' END OF TEST 10990020 DC AL1(ERR110-ERR100-24) 11000020 SPACE 2 11010020 * 2302,2303,2311,2314 TEST CHANNEL SENSE BYTES ROUTINE. 11020020 SPACE 2 11030020 ERR130A CLI 0(UCBREG),X'05' 2301 INTERRUPT 11040020 BE ERR730 YES - SERVICE IT 11050020 BH ERRB00 BRANCH TO 3330 AND S20201 11060020 * 2305 SENSE ROUTINES 11070020 CLI 0(UCBREG),X'00' 2321 11080020 BE ERR900 11090020 ERR130 BAL ERRLNK,ERRTEST LINK TO STATUS/SENSE BYTE 11100020 DC X'03' EQUIPMENT CHECK 11110020 DC AL1(ERR131-ERR130-4) 11120020 DC X'0C' NO RECORD FOUND 11130020 DC AL1(ERR132-ERR130-6) 11140020 DC X'07' SEEK CHECK 11150020 DC AL1(ERR139-ERR130-8) 11160020 DC X'01' INTERVENTION REQUIRED 11170020 DC AL1(ERR133-ERR130-10) 11180020 DC X'02' BUS OUT CHECK 11190020 DC AL1(ERR134-ERR130-12) 11200020 DC X'04' DATA CHECK 11210020 DC AL1(ERR135-ERR130-14) 11220020 DC X'05' OVERRUN 11230020 DC AL1(ERR137-ERR130-16) 11240020 DC X'00' COMMAND REJECT 11250021 DC AL1(ERR138-ERR130-18) 11260021 DC X'0E' MISSING ADDRESS MARKER 11270021 DC AL1(ERR145-ERR130-20) 11280021 DC X'06' TRACK CONDITION CHECK 11290020 DC AL1(ERR140-ERR130-22) 11300020 DC X'09' TRACK OVERRUN 11310020 DC AL1(ERR141-ERR130-24) 11320020 DC X'0A' END OF CYLINDER 11330020 DC AL1(ERR142-ERR130-26) 11340020 DC X'0D' FILE PROTECT 11350020 DC AL1(ERR143-ERR130-28) 11360020 DC X'0F' DASD OVERFLOW INCOMPLETE 11370020 DC AL1(ERR144-ERR130-30) 11380020 DC X'2F' END OF TEST 11390020 DC AL1(ERR146-ERR130-32) 11400020 SPACE 2 11410020 * EXITS TO 2302,2303,2311,2314 ERROR RECOVERY ROUTINES. 11420020 SPACE 2 11430020 ERR101 BC 15,CHANERR GO TO CHANNEL CONTROL CHECK RTN. 11440020 SPACE 1 11450020 ERR102 BC 15,INFCERR GO TO INTERFACE CONTROL CHECK 11460020 SPACE 1 11470020 ERR103 BC 15,CHDATA GO TO CHANNEL DATA CHECK ROUTINE 11480020 SPACE 1 11490020 ERR104 BC 15,NEVER GO TO SHOULD NOT OCCUR ROUTINE. 11500020 SPACE 1 11510020 ERR105 BAL LINK15,SIXTRY RETRY ERROR CCW LIST 6 TIMES. 11520020 BC 15,CHAINCHK SOLID ERROR-GO TO CHAINCHK RTN. 11530020 SPACE 1 11540020 ERR106 BC 15,PROCHK GO TO PROGRAM CHECK ROUTINE 11550020 SPACE 1 11560020 ERR107 BC 15,PTNCHK GO TO PROTECTION CHECK ROUTINE 11570020 SPACE 1 11580020 ERR108 BC 15,DISKEOF RETURN TO DISK EOF ROUTINE. 11590020 SPACE 1 11600020 ERR109 TM WLRECSW,X'01' 2311 - 2302 RESTORE 11610020 BC 14,WLRERR NO--EXIT TO WRONG LENGTH RECORD. 11620020 B INDEXRTN 2302 WRONG LENGTH RECORD//RETURN 11630020 SPACE 1 11640020 ERR110 BC 15,ENDTEST GO TO END OF TEST ROUTINE 11650020 SPACE 1 11660020 ERR131 BAL LINK15,TENTRY RETRY ERROR CCW UP TO 10 TIMES. 11670020 BC 15,EQUIPCHK SOLID ERROR-GO TO EQUIPCHK ROUTINE 11680020 SPACE 1 11690020 ERR132 TM 25(UCBREG),X'02' MISSING ADDRESS MARKER 11700020 BO ERR132A YES-DO TWO SEEK 11710020 BAL LINK15,CYLNCHK NO-CHECK IF AT RIGHT CYLINDER 11720020 BAL LINK1,TENSEEK RESEEK/RETRY CCW LIST TEN TIMES 11730020 B NORECFND SOLID ERROR 11740020 ERR132A BAL LINK1,TWOSEEK RETRY TWICE 11750020 BC 15,NORECFND SOLID ERROR-GO TO NORECFND RTN. 11760020 SPACE 1 11770020 ERR133 BAL LINK15,INTVREQ LINK TO INTERVENTION REQ. ROUTIN 11780020 MVC READYDEV(27),DISKMSG INSERT DISKMSG//CLEAR CUU FIELD. 11790020 MVC READYDEV+20(3),IOCONV+1 SET DEVICE ADDR. IN OPR MESSAGE. 11800020 B DEVWAIT GO TO DEVICE WAIT ROUTINE. 11810020 SPACE 1 11820020 ERR134 BAL LINK15,TWOTRY RETRY ERROR CCW LIST ONCE MORE. 11830020 BC 15,BUSOUT SOLID ERROR-GO TO BUSOUT RTN. 11840020 SPACE 1 11850020 ERR135 BAL LINK15,SIXTTRY 11860020 BC 15,DATACHK SOLID ERROR-GO TO DATACHK RTN. 11870020 SPACE 1 11880020 ERR137 BAL LINK15,SIXTRY RETRY ERROR CCW SIX TIMES 11890020 BC 15,OVRRUN SOLID ERROR-GO TO OVERRUN RTN. 11900020 SPACE 1 11910020 ERR138 TM 25(UCBREG),X'02' IS WRITE INHIBIT ON 11915021 BO INHIBIT YES, BR TO TERMINATE 11920021 TM 25(UCBREG),X'04' DID FILE PROTECT OCCUR 11925021 BC 1,INDEXRTN YES--GO TO INDEX RETURN ROUTINE. 11930020 BC 14,COMREJ NO--GO TO COMMAND REJECT RTN. 11940020 ERR138A TM 25(UCBREG),X'04' DID FILE PROTECT OCCUR ALSO 6601 11950020 BC 1,INDEXRTN YES,GO TO INDEX RETRN RTNE 6601 11960020 BC 14,ENDOFCYL GO TO END OF CYL ROUTINE 6601 11970020 SPACE 1 11980020 ERR139 BAL LINK1,TENSEEK RESEEK/RETRY CCW LIST TEN TIMES 11990020 BC 15,SEEKCHK GO TO SEEK CHECK ROUTINE. 12000020 SPACE 1 12010020 ERR140 BC 15,INDEXRTN TRACK CONDITION CHECK; RETURN 12020020 SPACE 1 12030020 ERR141 BC 15,TROVRRUN GO TO TRACK OVERRUN ROUTINE 12040020 SPACE 1 12050020 ERR142 BC 15,ENDOFCYL GO TO END OF CYLINDER ROUTINE 12060020 SPACE 1 12070020 ERR143 BC 15,INDEXRTN FILE PROTECT; RETURN 12080020 SPACE 1 12090020 ERR144 BC 15,INDEXRTN OVERFLOW INCOMPLETE; RETURN 12100020 SPACE 1 12110020 ERR145 BAL LINK15,TENTRY RETRY ERROR CCW TEN TIMES. 12120020 B MISSMARK MISSING ADDRESS MARKER ROUTINE. 12130020 SPACE 1 12140020 ERR146 BC 15,ENDTEST GO TO END OF TEST ROUTINE. 12150020 EJECT 12160020 * ******************************************** 12170020 * * FOLLOWING ROUTINES USED BY 1442 AND 1402 * 12180020 * ******************************************** 12190020 SPACE 2 12200020 * 1442 AND 1402 TEST CHANNEL STATUS BYTES ROUTINE. 12210020 SPACE 1 12220020 ERR200 BAL ERRLNK,ERRTEST LINK TO STATUS/SENSE BYTES TEST. 12230020 DC X'1D' CHANNEL CONTORL CHECK 12240020 DC AL1(ERR201-ERR200-4) 12250020 DC X'1E' INTERFACE CONTROL CHECK 12260020 DC AL1(ERR202-ERR200-6) 12270020 DC X'1C' CHANNEL DATA CHECK 12280020 DC AL1(ERR203-ERR200-8) 12290020 DC X'10' SHOULD NOT OCCUR 12300020 DC AL1(ERR204-ERR200-10) 12310020 DC X'11' SHOULD NOT OCCUR 12320020 DC AL1(ERR204-ERR200-12) 12330020 DC X'12' SHOULD NOT OCCUR 12340020 DC AL1(ERR204-ERR200-14) 12350020 DC X'16' UNIT CHECK 12360020 DC AL1(ERR230-ERR200-16) 12370020 DC X'1F' CHAINING CHECK 12380020 DC AL1(ERR205-ERR200-18) 12390020 DC X'1A' PROGRAM CHECK 12400020 DC AL1(ERR206-ERR200-20) 12410020 DC X'1B' PROTECTION CHECK 12420020 DC AL1(ERR207-ERR200-22) 12430020 DC X'17' UNIT EXCEPTION 12440020 DC AL1(ERR208-ERR200-24) 12450020 DC X'19' INCORRECT LENGTH 12460020 DC AL1(ERR209-ERR200-26) 12470020 DC X'2F' END OF TEST 12480020 DC AL1(ERR210-ERR200-28) 12490020 SPACE 1 12500020 * 1402 AND 1442 TEST CHANNEL SENSE BYTES 12510020 SPACE 1 12520020 ERR230 BAL ERRLNK,ERRTEST LINK TO STATUS/SENSE BYTES TEST. 12530020 DC X'06' SHOULD NOT OCCUR 12540020 DC AL1(ERR231-ERR230-4) 12550020 DC X'07' SHOULD NOT OCCUR 12560020 DC AL1(ERR231A-ERR230-6) SHOULD NOT OCCUR S20201 12570020 DC X'03' EQUIPMENT CHECK 12580020 DC AL1(ERR232-ERR230-8) 12590020 DC X'01' INTERVENTION REQUIRED 12600020 DC AL1(ERR233-ERR230-10) 12610020 DC X'02' BUS OUT CHECK 12620020 DC AL1(ERR234-ERR230-12) 12630020 DC X'04' DATA CHECK 12640020 DC AL1(ERR235-ERR230-14) 12650020 DC X'05' OVERRUN 12660020 DC AL1(ERR236-ERR230-16) 12670020 DC X'00' COMMAND REJECT 12680020 DC AL1(ERR237-ERR230-18) 12690020 DC X'2F' END OF TEST 12700020 DC AL1(ERR238-ERR230-20) 12710020 SPACE 1 12720020 * EXITS TO 1442 DUMP/RESTORE ERROR RECOVERY ROUTINES. 12730020 SPACE 1 12740020 ERR201 BC 15,CHANERR GO TO CHANNEL CONTROL CHECK RTN. 12750020 SPACE 1 12760020 ERR202 BC 15,INFCERR GO TO INTERFACE CONTROL CHECK 12770020 SPACE 1 12780020 ERR203 BC 15,CHDATA GO TO CHANNEL DATA ERROR ROUTINE 12790020 SPACE 1 12800020 ERR204 BC 15,NEVER GO TO SHOULD NOT OCCUR ROUTINE 12810020 SPACE 1 12820020 ERR205 BC 15,CHAINCHK GO TO CHAINING CHECK ROUTINE 12830020 SPACE 1 12840020 ERR206 BC 15,PROCHK GO TO PROGRAM CHECK ROUTINE 12850020 SPACE 1 12860020 ERR207 BC 15,PTNCHK GO TO PROTECTION CHECK ROUTINE 12870020 SPACE 1 12880020 ERR208 BC 15,UNITCEPT GO TO UNIT EXCEPTION ROUTINE 12890020 SPACE 1 12900020 ERR209 BC 15,WLRERR GO TO INCORRECT LENGTH ROUTINE 12910020 SPACE 1 12920020 ERR210 BC 15,ENDTEST GO TO END OF TEST ROUTINE 12930020 SPACE 1 12940020 SPACE 1 12950020 ERR231 CLI ZERR(UCBREG),T1402 IS DEVICE A 1402 S20201 12960020 BE SEQERR YES, GO TO CMD SEQ RTN S20201 12970020 B NEVER SHOULD NOT OCCUR RTN S20201 12980020 SPACE 1 12990020 ERR231A B NEVER SHOULD NOT OCCUR RTN S20201 13000020 SPACE 1 13010020 ERR232 LA GR2,READCHK ADDR OF READ CHECK MSG S20201 13020020 LA GR1,60 MESSAGE LENGTH S20201 13030020 B TYPEWAIT TYPE MESSAGE AND WAIT S20201 13040020 SPACE 1 13050020 ERR233 BAL LINK15,INTVREQ INT. REQ. ROUTINE S20201 13060020 MVC READYDEV(27),READYRDR INSERT READY RDR MSG S20201 13070020 MVC READYDEV+22(3),IOCONV+1 SET DEVICE IN MSG S20201 13080020 B DEVWAIT GO TO WAIT RTN S20201 13090020 SPACE 1 13100020 ERR234 B ERR134 USE 2311 BUSOUT RTN S20201 13110020 SPACE 1 13120020 ERR235 LA GR2,INVALCRD ADDR OF ERROR MSG S20201 13130020 LA GR1,64 LENGTH OF MSG S20201 13140020 B TYPEWAIT TYPE MSG AND WAIT S20201 13150020 SPACE 1 13160020 ERR236 CLI ZERR(UCBREG),T1402 IS DEVICE A 1402 S20201 13170020 BE NEVER YES, SHOULD NOT OCCUR S20201 13180020 B OVRRUN GO TO OVERRUN RTN S20201 13190020 SPACE 1 13200020 ERR237 BC 15,COMREJ GO TO COMMAND REJECT ROUTINE 13210020 SPACE 1 13220020 ERR238 BC 15,ENDTEST GO TO END OF TEST ROUTINE 13230020 EJECT 13240020 * **************************************************** 13250020 * * FOLLOWING ROUTINES FOR 2400 MAGNETIC TAPE UNIT * 13260020 * **************************************************** 13270020 SPACE 2 13280020 * 2400 TAPE TEST CHANNEL STATUS BYTES ROUTINE. 13290020 SPACE 2 13300020 ERR300 BAL ERRLNK,ERRTEST LINK TO STATUS/SENSE TEST RTN. 13310020 DC X'1D' CHANNEL CONTROL CHECK 13320020 DC AL1(ERR301-ERR300-4) 13330020 DC X'1E' INTERFACE CONTROL CHECK 13340020 DC AL1(ERR302-ERR300-6) 13350020 DC X'1C' CHANNEL DATA CHECK 13360020 DC AL1(ERR303-ERR300-8) 13370020 DC X'10' SHOULD NOT OCCUR 13380020 DC AL1(ERR304-ERR300-10) 13390020 DC X'16' UNIT CHECK 13400020 DC AL1(ERR330-ERR300-12) 13410020 DC X'1F' CHAINING CHECK 13420020 DC AL1(ERR305-ERR300-14) 13430020 DC X'1A' PROGRAM CHECK 13440020 DC AL1(ERR306-ERR300-16) 13450020 DC X'1B' PROTECTION CHECK 13460020 DC AL1(ERR307-ERR300-18) 13470020 DC X'17' UNIT EXCEPTION 13480020 DC AL1(ERR308-ERR300-20) 13490020 DC X'19' INCORRECT LENGTH 13500020 DC AL1(ERR309-ERR300-22) 13510020 DC X'2F' END OF TEST 13520020 DC AL1(ERR310-ERR300-24) 13530020 SPACE 2 13540020 * 2400 TAPE TEST CHANNEL SENSE BYTES ROUTINE. 13550020 SPACE 2 13560020 ERR330 BAL ERRLNK,ERRTEST LINK TO STATUS/SENSE BYTES TEST. 13570020 DC X'02' BUS OUT CHECK 13580020 DC AL1(ERR334-ERR330-4) 13590020 DC X'03' EQUIPMENT CHECK 13600020 DC AL1(ERR332-ERR330-6) 13610020 DC X'01' INTERVENTION REQ 13620020 DC AL1(ERR333-ERR330-8) 13630020 DC X'05' OVER RUN 13640020 DC AL1(ERR336-ERR330-10) 13650020 DC X'04' DATA CHECK. 5434 13660020 DC AL1(ERR335-ERR330-12) 5434 13670020 DC X'08' NOISE. 5434 13680020 DC AL1(ERR331-ERR330-14) 5434 13690020 DC X'07' DATA CONVERT CHECK 13700020 DC AL1(ERR337-ERR330-16) 13710020 DC X'00' COMMAND REJECT 13720020 DC AL1(ERR338-ERR330-18) 13730020 DC X'0C' TAPE AT LOAD POINT 13740020 DC AL1(ERR339-ERR330-20) 13750020 DC X'2F' END OF TEST 13760020 DC AL1(ERR340-ERR330-22) 13770020 SPACE 2 13780020 * EXITS TO 2400 TAPE ERROR RECOVERY ROUTINES. 13790020 SPACE 2 13800020 ERR301 BC 15,CHANERR GO TO CHANNEL CONTROL CHECK RTN. 13810020 SPACE 1 13820020 ERR302 BC 15,INFCERR GO TO INTERFACE CONTROL CHECK 13830020 SPACE 1 13840020 ERR303 BC 15,CHDATA GO TO CHANNEL DATA CHECK ROUTINE 13850020 SPACE 1 13860020 ERR304 BC 15,NEVER GO TO SHOULD NOT OCCUR ROUTINE 13870020 SPACE 1 13880020 ERR305 BAL LINK15,BACKSPC GO TO BACKSPACE ROUTINE 13890020 BAL LINK15,SIXTRY RETRY ERROR CCW LIST 6 TIMES. 13900020 BC 15,CHAINCHK SOLID ERROR-GO TO CHAINCHK RTN. 13910020 SPACE 1 13920020 ERR306 BC 15,PROCHK GO TO PROGRAM CHECK ROUTINE 13930020 SPACE 1 13940020 ERR307 BC 15,PTNCHK GO TO PROTECTION CHECK ROUTING 13950020 SPACE 1 13960020 ERR308 LM 0,15,ERRSAV1 RESTORE ORIGINAL P/P REGISTERS. 13970020 TM CKVOLSW,X'80' IS IT END OF TAPE ALSO 13980020 BC 1,IORTRN YES, NORMAL RETURN 13990020 BC 15,TAPEEOF RETURN TO TAPE EOF ROUTINE 14000020 SPACE 1 14010020 ERR309 BC 15,WLRERR GO TO INCORRECT LENGTH ROUTINE 14020020 SPACE 1 14030020 ERR310 BC 15,ENDTEST GO TO END OF TEST ROUTINE 14040020 SPACE 2 14050020 ERR331 BC 15,NOISETST TEST FOR NOISE RECORD ROUTINE. 14060020 SPACE 1 14070020 ERR332 BC 15,EQUIPCHK GO TO EQUIPMENT CHECK ROUTINE 14080020 SPACE 1 14090020 ERR333 BAL LINK15,INTVREQ LINK TO INTERVENTION REQ ROUTINE 14100020 MVC READYDEV(27),TAPEMSG INSERT DISKMSG//CLEAR CUU FIELD. 14110020 MVC READYDEV+20(3),IOCONV+1 SET DEVICE ADDR. IN OPR MESSAGE. 14120020 B DEVWAIT GO TO DEVICE WAIT ROUTINE. 14130020 SPACE 1 14140020 ERR334 BAL LINK15,BACKSPC BACKSPACE THE TAPE ONE RECORD. 14150020 BAL LINK15,TWOTRY RETRY ERROR CCW LIST ONCE MORE. 14160020 BC 15,BUSOUT SOLID ERROR-GO TO BUSOUT ROUTINE 14170020 SPACE 1 14180020 ERR335 BC 15,TAPEDATA TEST READ OR WRITE OPERATION 14190020 SPACE 1 14200020 ERR336 BAL LINK15,BACKSPC LINK TO TAPE BACKSPACE ROUTINE 14210020 BAL LINK15,SIXTRY RETRY ERROR CCW UP TO SIX TIMES 14220020 BC 15,OVRRUN SOLID ERROR-GO TO OVERRUN RTN. 14230020 SPACE 1 14240020 ERR337 BC 15,CONVTERR GO TO DATA CONVERT ERROR ROUTINE 14250020 SPACE 1 14260020 ERR338 TM 25(UCBREG),X'02' DID FILE PROTECT OCCUR ALSO. 14270020 BC 1,FILEPROT YES..GO TO FILE PROTECTED RTN. 14280020 BC 14,COMREJ NO...GO TO COMMAND REJECT RTN. 14290020 SPACE 1 14300020 ERR339 BC 15,TAPELP GO TO LOAD POINT ERROR RTN. 14310020 SPACE 1 14320020 ERR340 BC 15,ENDTEST GO TO END OF TEST ROUTINE 14330020 EJECT 14340020 * ********************************************* 14350020 * * FOLLOWING ROUTINES USED BY 1403 AND 1443 * 14360020 * ********************************************* 14370020 SPACE 2 14380020 * 1403 AND 1443 TEST CHANNEL STATUS BYTES ROUTINE. 14390020 SPACE 2 14400020 ERR400 BAL ERRLNK,ERRTEST LINK TO STATUS/SENSE BYTES TEST. 14410020 DC X'1D' CHANNEL CONTORL CHECK 14420020 DC AL1(ERR401-ERR400-4) 14430020 DC X'1E' INTERFACE CONTROL CHECK 14440020 DC AL1(ERR402-ERR400-6) 14450020 DC X'1C' CHANNEL DATA CHECK 14460020 DC AL1(ERR403-ERR400-8) 14470020 DC X'10' SHOULD NOT OCCUR 14480020 DC AL1(ERR404-ERR400-10) 14490020 DC X'11' SHOULD NOT OCCUR 14500020 DC AL1(ERR404-ERR400-12) 14510020 DC X'12' SHOULD NOT OCCUR 14520020 DC AL1(ERR404-ERR400-14) 14530020 DC X'1F' SHOULD NOT OCCUR 14540020 DC AL1(ERR404-ERR400-16) 14550020 DC X'16' UNIT CHECK 14560020 DC AL1(ERR430-ERR400-18) 14570020 DC X'1A' PROGRAM CHECK 14580020 DC AL1(ERR405-ERR400-20) 14590020 DC X'1B' PROTECTION CHECK 14600020 DC AL1(ERR406-ERR400-22) 14610020 DC X'17' UNIT EXCEPTION 14620020 DC AL1(ERR407-ERR400-24) 14630020 DC X'19' INCORRECT LENGTH 14640020 DC AL1(ERR408-ERR400-26) 14650020 DC X'2F' END OF TEST 14660020 DC AL1(ERR409-ERR400-28) 14670020 SPACE 2 14680020 * 1403 AND 1443 TEST CHANNEL SENSE BYTES ROUTINE 14690020 SPACE 1 14700020 ERR430 BAL ERRLNK,ERRTEST LINK TO STATUS/SENSE BYTES TEST. 14710020 DC X'06' SHOULD NOT OCCUR 14720020 DC AL1(ERR431-ERR430-4) SHOULD NOT OCCUR S20201 14730020 DC X'03' EQUIPMENT CHECK 14740020 DC AL1(ERR432-ERR430-6) EQUIPMENT CHECK S20201 14750020 DC X'01' INTERVENTION REQUIRED 14760020 DC AL1(ERR433-ERR430-8) INTERVENTION REQ S20201 14770020 DC X'02' BUS OUT CHECK 14780020 DC AL1(ERR434-ERR430-10) BUS OUT CHECK S20201 14790020 DC X'07' CHANNEL 9 14800020 DC AL1(ERR435-ERR430-12) CHANNEL 9 S20201 14810020 DC X'00' COMMAND REJECT 14820020 DC AL1(ERR436-ERR430-14) COMMAND REJECT S20201 14830020 DC X'04' SHOULD NOT OCCUR S20201 14840020 DC AL1(ERR431A-ERR430-16) SHOULD NOT OCCUR S20201 14850020 DC X'05' SHOULD NOT OCCUR S20201 14860020 DC AL1(ERR431A-ERR430-18) SHOULD NOT OCCUR S20201 14870020 DC X'2F' END OF TEST 14880020 DC AL1(ERR437-ERR430-20) 14890020 SPACE 1 14900020 * EXITS TO 1403 ERROR RECOVERY ROUTINES. 14910020 SPACE 1 14920020 ERR401 BC 15,CHANERR GO TO CHANNEL ERROR ROUTINE 14930020 SPACE 1 14940020 ERR402 BC 15,INFCERR GO TO INTERFACE ERROR ROUTINE 14950020 SPACE 1 14960020 ERR403 BC 15,CHDATA GO TO CHANNEL DATA ERROR ROUTINE 14970020 SPACE 1 14980020 ERR404 BC 15,NEVER GO TO SHOULD NOT OCCUR ROUTINE 14990020 SPACE 1 15000020 ERR405 BC 15,PROCHK GO TO PROGRAM CHECK ROUTINE 15010020 SPACE 1 15020020 ERR406 BC 15,PTNCHK GO TO PROTECTION CHECK ROUTINE 15030020 SPACE 1 15040020 ERR407 BC 15,SKIPTO1 GO TO CARRIAGE SKIP TO 1 ROUTINE 15050020 SPACE 1 15060020 ERR408 BC 15,WLRERR GO TO INCORRECT LENGTH ROUTINE 15070020 SPACE 1 15080020 ERR409 BC 15,ENDTEST GO TO END OF TEST ROUTINE 15090020 SPACE 1 15100020 ERR431 BC 15,NEVER GO TO SHOULD NOT OCCUR ROUTINE 15110020 SPACE 1 15120020 ERR432 LA GR2,PRINTCHK ADDRESS OF PRINT CHECK MESSAGE. 15130020 LA GR1,59 LENGTH OF MESSAGE IN BYTES. 15140020 BC 15,TYPEWAIT GO TO PRINT OPERATOR MSG//WAIT// 15150020 SPACE 1 15160020 ERR433 LA GR7,UCBSYO GET ADDRESS OF SYSOUT DEVICE. 15170020 BAL LINK15,UNITADDR CONVERT HEX UNIT ADDRESS TO BCD. 15180020 MVC READYDEV(27),READYPRT INSERT READYPRT//CLEAR CUU FIELD 15190020 MVC READYDEV+23(3),UNITBUF+1 INSERT DEVICE ADDR IN MESSAGE. 15200020 B DEVWAIT GO TO DEVICE WAIT ROUTINE. 15210020 SPACE 1 15220020 ERR434 B ERR134 USE 2311 BUSOUT RTN S20201 15230020 SPACE 1 15240020 ERR435 B INDEXRTN CHANNEL NINE SENSED//RETURN 15250020 SPACE 1 15260020 ERR436 BC 15,COMREJ GO TO COMMAND REJECT ROUTINE 15270020 ERR431A CLI ZERR(UCBREG),T1443 IS DEVICE A 1443 S20201 15280020 BE ERR437 YES, GOTO END OF TEST S20201 15290020 B NEVER SHOULD NOT OCCUR S20201 15300020 SPACE 1 15310020 ERR437 BC 15,ENDTEST GO TO END OF TEST ROUTINE 15320020 EJECT 15330020 * ***************************************************** 15340020 * * FOLLOWING ROUTINES USED BY 1052,2150 I/O WRITERS * 15350020 * ***************************************************** 15360020 SPACE 2 15370020 * 1052 I/O WRITER TEST CHANNEL STATUS BYTES ROUTINE. 15380020 SPACE 2 15390020 ERR500 BAL ERRLNK,ERRTEST LINK TO STATUS/SENSE BYTES TEST. 15400020 DC X'1D' CHANNEL CONTROL CHECK 15410020 DC AL1(ERR501-ERR500-4) 15420020 DC X'1E' INTERFACE CONTROL CHECK 15430020 DC AL1(ERR502-ERR500-6) 15440020 DC X'1C' CHANNEL DATA CHECK 15450020 DC AL1(ERR503-ERR500-8) 15460020 DC X'11' SHOULD NOT OCCUR 15470020 DC AL1(ERR504-ERR500-10) 15480020 DC X'12' SHOULD NOT OCCUR 15490020 DC AL1(ERR504-ERR500-12) 15500020 DC X'16' UNIT CHECK 15510020 DC AL1(ERR530-ERR500-14) 15520020 DC X'1F' CHAINING CHECK 15530020 DC AL1(ERR505-ERR500-16) 15540020 DC X'1A' PROGRAM CHECK 15550020 DC AL1(ERR506-ERR500-18) 15560020 DC X'1B' PROTECTION CHECK 15570020 DC AL1(ERR507-ERR500-20) 15580020 DC X'17' UNIT EXCEPTION 15590020 DC AL1(ERR508-ERR500-22) 15600020 DC X'19' INCORRECT LENGTH 15610020 DC AL1(ERR509-ERR500-24) 15620020 DC X'2F' END OF TEST 15630020 DC AL1(ERR510-ERR500-26) 15640020 SPACE 2 15650020 * 1052 I/O WRITER TEST CHANNEL SENSE BYTES ROUTINE. 15660020 SPACE 1 15670020 ERR530 BAL ERRLNK,ERRTEST LINK TO STATUS/SENSE BYTES TEST. 15680020 DC X'07' SHOULD NOT OCCUR 15690020 DC AL1(ERR531-ERR530-4) 15700020 DC X'06' SHOULD NOT OCCUR 15710020 DC AL1(ERR531-ERR530-6) 15720020 DC X'05' SHOULD NOT OCCUR 15730020 DC AL1(ERR531-ERR530-8) 15740020 DC X'04' SHOULD NOT OCCUR 15750020 DC AL1(ERR531-ERR530-10) 15760020 DC X'03' EQUIPMENT CHECK 15770020 DC AL1(ERR532-ERR530-12) 15780020 DC X'01' INTERVENTION REQUIRED 15790020 DC AL1(ERR533-ERR530-14) 15800020 DC X'02' BUS OUT CHECK 15810020 DC AL1(ERR534-ERR530-16) 15820020 DC X'00' COMMAND REJECT 15830020 DC AL1(ERR535-ERR530-18) 15840020 DC X'2F' END OF TEST 15850020 DC AL1(ERR536-ERR530-20) 15860020 SPACE 1 15870020 * EXITS TO 1052 I/O WRITER ERROR RECOVERY ROUTINES. 15880020 SPACE 1 15890020 ERR501 BC 15,CHANERR GO TO CHANNEL CONTROL ERROR RTN. 15900020 SPACE 1 15910020 ERR502 BC 15,INFCERR GO TO INTERFACE CONTROL CHECK 15920020 SPACE 1 15930020 ERR503 BC 15,CHDATA GO TO CHANNEL DATA CHECK ROUTINE 15940020 SPACE 1 15950020 ERR504 BC 15,NEVER GO TO SHOULD NOT OCCUR ROUTINE 15960020 SPACE 1 15970020 ERR505 BC 15,CHAINCHK GO TO CHAINING CHECK ROUTINE 15980020 SPACE 1 15990020 ERR506 BC 15,PROCHK GO TO PROGRAM CHECK ROUTINE 16000020 SPACE 1 16010020 ERR507 BC 15,PTNCHK GO TO PROTECTION CHECK ROUTINE 16020020 SPACE 1 16030020 ERR508 LM 0,15,ERRSAV1 RESTORE REGS TO RETRY TYPER CCW. 16040020 B ATTN1 RETRY TYPEWRITER RD CCW SA58009 16050021 SPACE 1 16060020 ERR509 BC 15,WLRERR GO TO INCORRECT LENGTH ROUTINE 16070020 SPACE 1 16080020 ERR510 BC 15,ENDTEST GO TO END OF TEST ROUTINE 16090020 SPACE 1 16100020 ERR531 BC 15,NEVER GO TO SHOULD NOT OCCUR ROUTINE 16110020 SPACE 1 16120020 ERR532 TM 8(UCBREG),X'01' TYPER IN READ OR WRITE STATUS 16130020 BC 14,FAILREAD READ STATUS--PRINT MESSAGE//WAIT 16140020 BAL LINK15,TWOTRY WRITE STATUS--RETRY TYPER CCW. 16150020 B WAITTRY GO TO WAIT//RETRY CCW ROUTINE. 16160020 SPACE 1 16170020 FAILREAD LA GR2,TYPEFAIL ADDR OF I/OWRITER READ ERROR MSG 16180020 LA GR1,72 LENGTH OF MESSAGE IN BYTES. 16190020 BC 15,TYPEWAIT GO TO TYPE MESSAGE//WAIT ROUTINE 16200020 SPACE 1 16210020 ERR533 B WAITTRY GO TO WAIT ROUTINE//RETRY CCW. 16220020 SPACE 1 16230020 ERR534 B ERR134 USE 2311 BUSOUT RTN S20201 16240020 SPACE 1 16250020 ERR535 BC 15,COMREJ GO TO COMMAND REJECT ROUTINE 16260020 SPACE 1 16270020 ERR536 BC 15,ENDTEST GO TO END OF TEST ROUTINE 16280020 EJECT 16290020 EJECT 16300020 * ************************************************ 16310020 * * FOLLOWING ROUTINE USED BY 2301 DASD DEVICE * 16320020 * ************************************************ 16330020 SPACE 2 16340020 * 2301 DASD TEST CHANNEL SENSE BYTES ROUTINE. 16350020 SPACE 2 16360020 ERR730 BAL ERRLNK,ERRTEST LINK TO STATUS/SENSE BYTES TEST. 16370020 DC X'03' EQUIPMENT CHECK. 16380020 DC AL1(ERR732-ERR730-4) 16390020 DC X'0C' NO RECORD FOUND. 16400020 DC AL1(ERR741-ERR730-6) 16410020 DC X'07' INVALID ADDRESS. 16420020 DC AL1(ERR738-ERR730-8) 16430020 DC X'01' INTERVENTION REQUIRED. 16440020 DC AL1(ERR733-ERR730-10) 16450020 DC X'02' BUS OUT CHECK. 16460020 DC AL1(ERR734-ERR730-12) 16470020 DC X'04' DATA CHECK. 16480020 DC AL1(ERR735-ERR730-14) 16490020 DC X'05' OVERRUN. 16500020 DC AL1(ERR736-ERR730-16) 16510020 DC X'00' COMMAND REJECT. 16520020 DC AL1(ERR737-ERR730-18) 16530020 DC X'06' SHOULD NOT OCCUR. 16540020 DC AL1(ERR731-ERR730-20) 16550020 DC X'09' TRACK OVERRUN. 16560020 DC AL1(ERR739-ERR730-22) 16570020 DC X'0A' END OF CYLINDER. 16580020 DC AL1(ERR740-ERR730-24) 16590020 DC X'0D' FILE PROTECTED 16600020 DC AL1(ERR742-ERR730-26) 16610020 DC X'0F' OVERFLOW INCOMPLETE 16620020 DC AL1(ERR743-ERR730-28) 16630020 DC X'2F' END OF TEST 16640020 DC AL1(ERR744-ERR730-30) 16650020 SPACE 2 16660020 * EXITS TO 2301 DASD ERROR RECOVERY ROUTINES. 16670020 SPACE 2 16680020 ERR731 BC 15,NEVER GO TO SHOULD NOT OCCUR ROUTINE 16690020 SPACE 1 16700020 ERR732 BAL LINK15,TWOTRY RETRY ERROR CCW LIST ONCE MORE. 16710020 BC 15,EQUIPCHK SOLID ERROR-GO TO EQUIPCHK RTN. 16720020 SPACE 1 16730020 ERR733 B ERR133 GO TO 2302 INTERVENTION REQ RTN. 16740020 SPACE 1 16750020 ERR734 B ERR134 USE 2311 BUSOUT RTN S20201 16760020 SPACE 1 16770020 ERR735 BAL LINK15,TENTRY RETRY ERROR CCW LIST TEN TIMES. 16780020 BC 15,DATACHK SOLID ERROR-GO TO DATACHK RTN. 16790020 SPACE 1 16800020 ERR736 B ERR137 USE 2311 OVERRUN RTN S20201 16810020 SPACE 1 16820020 ERR737 BC 15,ERR138 USE 2311 COMMAND REJECT 16830020 SPACE 1 16840020 ERR738 BC 15,INVLDADR GO TO INVALID ADDRESS ROUTINE 16850020 SPACE 1 16860020 ERR739 BC 15,TROVRRUN GO TO TRACK OVERRUN ROUTINE 16870020 SPACE 1 16880020 ERR740 BC 15,ERR138A DID FILE PROTECT OCCUR ALSO 6601 16890020 SPACE 1 16900020 ERR741 BC 15,NORECFND GO TO RECORD FOUND ROUTINE 16910020 SPACE 1 16920020 ERR742 BC 15,ERR143 USE 2311 FILE PROTECT 16930020 SPACE 1 16940020 ERR743 BC 15,OVRFLOW GO TO OVERFLOW INCOMPLETE RTN. 16950020 SPACE 1 16960020 ERR744 BC 15,ENDTEST GO TO END OF TEST ROUTINE 16970020 EJECT 16980020 *********************************************************** 16990020 * FOLLOWING ROUTINES USED BY 3330 AND 2305 * 17000020 *********************************************************** 17010020 ERRB00 CLI ZERR(UCBREG),T3330 IS DEVICE A 3330 S20201 17020020 BNE ERRB01 NO - CHECK 2305 S20201 17030020 TM TWOSIX(UCBREG),TEN CHECK FOR ENV DATA S20201 17040020 BNO ERRA00 CHECK REST OF SENSE S20201 17050020 ENVDATA BAL LINK15,TWOTRY RETRY CCW TWO TIMES S20201 17060020 B ERRA00 CHECK REST OF SENSE S20201 17070020 ERRB01 TM TWOSIX(UCBREG),EIGHTY CHECK FOR BUFLOG FULL S20201 17080020 BNO ERRA00 CHECK REST OF SENSE S20201 17090020 RDBUFLOG MVC SAVECCW(L2),L6(UCBREG) SAVE CCW IN ERROR S20201 17100020 LA RCAW,BUFCCW READ BUFFER LOG CCW S20201 17110020 BAL LINK9,STARTIO START THE IO S20201 17120020 MVC L6(L2,UCBREG),SAVECCW RESTORE CCW IN ERROR S20201 17130020 BAL LINK15,TWOTRY RETRY CCW TWO TIMES S20201 17140020 ERRA00 BAL ERRLNK,ERRTEST LINK TO SENSE BYTE TEST S20201 17150020 DC X'03' EQUIPMENT CHECK S20201 17160020 DC AL1(ERRA01-ERRA00-4) EQUIPMENT CHECK S20201 17170020 DC X'0C' NO RECORD FOUND S20201 17180020 DC AL1(ERRA02-ERRA00-6) NO RECORD FOUND S20201 17190020 DC X'01' INTERVENTION REQUIRED S20201 17200020 DC AL1(ERRA03-ERRA00-8) INTERVENTION REQUIRED S20201 17210020 DC X'02' BUS OUT CHECK S20201 17220020 DC AL1(ERRA04-ERRA00-10) BUS OUT CHECK S20201 17230020 DC X'05' OVERRUN S20201 17240020 DC AL1(ERRA06-ERRA00-12) OVERRUN S20201 17250020 DC X'00' COMMAND REJECT S20201 17260020 DC AL1(ERRA07-ERRA00-14) COMMAND REJECT S20201 17270020 DC X'0A' END OF CYLINDER S20201 17280020 DC AL1(ERRA08-ERRA00-16) END OF CYLINDER S20201 17290020 DC X'0D' FILE PROTECT S20201 17300020 DC AL1(ERRA09-ERRA00-18) FILE PROTECT S20201 17310020 DC X'04' DATA CHECK S20201 17320020 DC AL1(ERRA05-ERRA00-20) DATA CHECK S20201 17330020 DC X'0F' OPERATION INCOMPLETE S20201 17340020 DC AL1(ERRA10-ERRA00-22) OPERATION INCOMPLETE S20201 17350020 DC X'09' INVALID TRK FORMAT S20201 17360020 DC AL1(ERRA12-ERRA00-24) INVALID TRK FORMAT S20201 17370020 DC X'2F' END OF TEST S20201 17380020 DC AL1(ERRA13-ERRA00-26) END OF TEST S20201 17390020 ERRA01 TM 25(UCBREG),X'80' IS PERM ERROR ON S20201 17400020 BO EQUIPCHK YES, BYPASS ERP S20201 17410020 B ERR131 USE 2311 EQUIPCHK RTN S20201 17420020 SPACE 1 17430020 ERRA02 B ERR132 GO TO NOREC FND RTN S20201 17440020 SPACE 1 17450020 ERRA03 B ERR133 GO TO DASD INT REQ RTN S20201 17460020 SPACE 1 17470020 ERRA04 B ERR134 USE 2311 BUS OUT RTN S20201 17480020 SPACE 1 17490020 ERRA05 TM 25(UCBREG),X'80' IS PERM ERROR ALSO S20201 17500020 BO DATACHK YES, USE 2311 ERP S20201 17510020 B ECFTEST NO, USE ECC FUNCTION S20201 17520020 SPACE 1 17530020 ERRA06 TM 25(UCBREG),X'80' IS PERM ERROR ALSO S20201 17540020 BO OVRRUN YES, BR TO TERMINATE S20201 17550020 B ERR137 USE 2311 OVERRUN RTN S20201 17560020 SPACE 1 17570020 ERRA07 B ERR138 USE 2311 COMMAND REJ 17580021 SPACE 1 17590020 ERRA08 B ENDOFCYL GO TO END OF CYL RTN S20201 17600020 SPACE 1 17610020 ERRA09 B ERR143 USE 2311 FILE PROT RTN S20201 17620020 SPACE 1 17630020 ERRA10 B ERR144 2311 DASD OVERFLOW RTN S20201 17640020 SPACE 1 17650020 ERRA12 B INTRKFMT BR TO INVALID TRK FORMAT S20201 17660020 SPACE 1 17670020 ERRA13 B ENDTEST BR TO END OF TEST RTN S20201 17680020 EJECT 17690020 EJECT 17700020 ERR900 BAL ERRLNK,ERRTEST LINK TO STATUS/SENSE BYTE TEST 17710020 DC X'03' EQUIPMENT CHECK 17720020 DC AL1(ERR901-ERR900-4) 17730020 DC X'0C' NO RECORD FOUND 17740020 DC AL1(ERR902-ERR900-6) 17750020 DC X'07' SEEK CHECK 17760020 DC AL1(ERR903-ERR900-8) 17770020 DC X'01' INTERVENTION REQUIRED 17780020 DC AL1(ERR904-ERR900-10) 17790020 DC X'02' BUSS OUT CHECK 17800020 DC AL1(ERR905-ERR900-12) 17810020 DC X'04' DATA CHECK 17820020 DC AL1(ERR906-ERR900-14) 17830020 DC X'05' OVERRUN 17840020 DC AL1(ERR907-ERR900-16) 17850020 DC X'0E' MISSING ADDRESS MARKER 17860020 DC AL1(ERR908-ERR900-18) 17870020 DC X'00' COMMAND REJECT 17880020 DC AL1(ERR909-ERR900-20) 17890020 DC X'06' TRACK CONDITION CHECK 17900020 DC AL1(ERR910-ERR900-22) 17910020 DC X'09' TRACK OVERRUN 17920020 DC AL1(ERR911-ERR900-24) 17930020 DC X'0A' END OF CYLINDER 17940020 DC AL1(ERR912-ERR900-26) 17950020 DC X'0D' FILE PROTECT 17960020 DC AL1(ERR913-ERR900-28) 17970020 DC X'2F' END OF TEST 17980020 DC AL1(ERR914-ERR900-30) 17990020 ERR901 B EQUIPCHK GO TO EQUIPCHK ROUTINE 18000020 SPACE 1 18010020 ERR902 TM 25(UCBREG),X'02' MISSING ADDRESS MARKER ALSO 18020020 BO ACTVIII YES, CHECK MORE 18030020 B ACTIX CORRECT CYLINDER 18040020 SPACE 1 18050020 ERR903 TM 25(UCBREG),X'02' MISSING ADDRESS MARKER ALSO 18060020 BO BALLAST YES, SEEKED BALLAST-SOLID ERROR 18070020 B ACTXI CHECK ON SEEK CHECK 18080020 SPACE 1 18090020 ERR904 B ERR133 INTERV REQUIRED;AS IN 2311 18100020 SPACE 1 18110020 ERR905 B ERR134 USE 2311 BUSOUT RTN S20201 18120020 SPACE 1 18130020 ERR906 BAL LINK1,ACTXII DATA CHECK 18140020 B DATACHK 18150020 SPACE 1 18160020 ERR907 BAL LINK15,TENTRY 18170020 B OVRRUN 18180020 SPACE 1 18190020 ERR908 BAL LINK1,ACTXII MISSING ADDRESS MARLER 18200020 B MISSMARK 18210020 SPACE 1 18220020 ERR909 B COMREJ 18230020 SPACE 1 18240020 ERR910 B INDEXRTN TRACK CONDITION CHECK 18250020 SPACE 1 18260020 ERR911 B TROVRRUN 18270020 SPACE 1 18280020 ERR912 B ENDOFCYL 18290020 SPACE 1 18300020 ERR913 B ERR143 FILE PROTECT 18310020 SPACE 1 18320020 ERR914 B ENDTEST 18330020 EJECT 18340020 ACTVIII TM ACTXIISW,X'40' ERROR CAUSED IN TEN TRY ROUTINE 18350020 BO TENTRY YES, TRY AGAIN IF NECESSARY 18360020 BAL LINK1,TRESEEK RESTORE, RETRY 3 TIMES 18370020 L REGD,ERRSAV1+12 GET CCW ADDRESS 18380020 L REGD,0(REGD) GET SEEK ADDRESS 18390020 MVC STORSEEK(6),0(REGD) MOVE IT 18400020 XI STORSEEK+5,X'01' CHANGE TO ANOTHER TRACK 18410020 MVI ACTXIISW,X'10' RETURN WITHOUT CHECKING ERROR 18420020 LA GR3,SOMEHOME ADDRESS OF CCW LIST 18430020 BAL LINK9,STARTIO SEEK, READ HA OF NEW TRACK 18440020 CLC STORSEEK+2(4),HOMEBUF+1 WAS THIS PROPER TRACK 18450020 BE ACTVIIIE YES, RETRY ORIGINAL 18460020 BAL LINK9,STARTIO NO, TRY AGAIN 18470020 CLC STORSEEK+2(4),HOMEBUF+1 WAS THIS PROPER TRACK 18480020 BNE ACTVIIID 18490020 ACTVIIIE MVI ACTXIISW,X'40' TELL ACTVIII WHERE WE ARE 18500020 BAL LINK15,TENTRY RETRY CCW LIST 10 TIMES 18510020 ACTVIIID MVI ACTXIISW,X'00' RESET SWITCH 18520020 B BLANKTRK SOLID//PRINT MSG//TERMINATE 18530020 SPACE 1 18540020 SOMEHOME CCW 7,STORSEEK,X'60',6 18550020 CCW X'1A',HOMEBUF,X'20',5 18560020 SPACE 1 18570020 ACTIX BAL LINK15,CYLNCHK READ HA- SEE IF COREECT CYL 18580020 BAL LINK1,ACTX NO-SEEK OTHER STRIP/RETRY 10TIME 18590020 B NORECFND YES-HARD ERROR. 18600020 SPACE 1 18610020 ACTX LA GR3,RESEEKM GET ADDRESS OF CCW LIST 18620020 MVC SEEK1X(2),BBCCHH GET 18630020 MVC SEEK2X(2),BBCCHH CELL ADDRESS 18640020 MVC SEEK1X+5(1),HH+1 SET UP THE HEAD ADDRESS. 18650020 MVC SEEK2X+5(1),HH+1 SET UP THE HEAD ADDRESS. 18660020 MVI ACTXIISW,X'10' SET FOR DIRECT RETURN. 18670020 BAL LINK9,STARTIO SEEK TO AN OFF TRACK. 18680020 MVI ACTXIISW,X'00' RESET DIRECT RETURN SWITCH. 18690020 BAL LINK15,TENTRY RETRY TEN TIMES 18700020 BR LINK1 SOLID RETURN TO USER 18710020 SPACE 1 18720020 RESEEKM CCW 7,SEEK1X,X'40',6 18730020 CCW 7,SEEK2X,X'00',6 18740020 SEEK1X DC X'0000010101010000' AT LEAST ONE ADDRESS 18750020 SEEK2X DC X'000003030303' DIFFERENT THAN ORIGINAL 18760020 SPACE 1 18770020 ACTXI TM 25(UCBREG),X'01' OVERFLOW INCPMPLETE ALSO 18780020 BZ ACTXIA NO - CHECK FURTHER 18790020 BAL LINK1,TENSEEK RESTORE, RETRY 10 TIMES 18800020 B SEEKCHK SOLID - SEEK CHECK ROUTINE 18810020 ACTXIA TM 24(UCBREG),X'80' COMMAND REJECT ALSO 18820020 BO SEEKCHK YES - SOLID 18830020 BAL LINK1,ACTX 18840020 B SEEKCHK SOLID 18850020 EJECT 18860020 ACTXII TM ACTXIISW,X'20' EXECUTING ORIGINAL CCW LIST. 18870020 BO TRETRY YES-RETURN TO TRETRY ROUTINE. 18880020 MVI ACTXIISW,X'21' NO-SET 1ST ENTRY(01)ORIGINAL(20) 18890020 L REGD,4(UCBREG) GET ADDRESS OF START OF CCW LIST 18900020 L REGD,0(REGD) PICK UP HALF OF SEEK CCW. 18910020 MVC HIADR(4),0(REGD) SET UP ADDRESS FOR SEEK HIGHEST. 18920020 MVC LOWADR(4),0(REGD) SET UP ADDRESS FOR SEEK LOWEST. 18930020 L REGE,LOWADR SET UP TO SEEK ONE STRIP OFF. 18940020 CLI HIADR+3,X'00' IS THIS STRIP ZERO. 18950020 BE ACTXIIA YES-USE NEXT HIGHER STRIP. 18960020 BCTR REGE,0 NO--USE NEXT LOWER STRIP. 18970020 B ACTXIIB USE NEXT LOWER--BYPASS NEXT STEP 18980020 ACTXIIA A REGE,F1 SEEK ADDRESS NEXT HIGHER STRIP. 18990020 ACTXIIB ST REGE,NXTLOW SEEK ADDRESS LOWER OR HIGHER. 19000020 LA REGE,4 SET UP FOR 8 RETRIES OF ORIGINAL 19010020 ACTXIIC BAL LINK15,TRETRY TWO RETRIES. 19020020 BCT REGE,ACTXIIC REPEAT SEQUENCE IF NECESSARY. 19030020 LA REGE,12 12 PASSES THRU LOOP2X. 19040020 LA REGF,1 1 PASS THRU LOOP2X AND LOOP3X. 19050020 SPACE 1 19060020 LOOP2X BAL LINK15,EIGHTTRY SEEK TO HIGH-LOW TRACKS 8 TIMES. 19070020 NI ACTXIISW,X'EF' TURN OFF DIRECT RETURN BIT. 19080020 BAL LINK15,TRETRY RETRY ORIGINAL CCW LIST TWICE. 19090020 BCT REGE,LOOP2X REPEAT SEQUENCE IF NECESSARY. 19100020 LA REGE,15 RESET THE LOOP COUNTER. 19110020 SPACE 1 19120020 LOOP3X LA RCAW,SNXTLOW SEEK COMMAND FOR NEXT LOWER 19130020 BAL LINK9,STARTIO OR STRIP ONE. 19140020 BAL LINK15,TRETRY RETRY ORIGINAL CCW LIST TWICE. 19150020 BCT REGF,LOOP2X REPEAT SEQUENCE IF NECESSARY. 19160020 XI ACTXIISW,X'01' RESET THE FIRST ENTRY SWITCH. 19170020 TM ACTXIISW,X'01' FIRST PASS THRU BOTH LOOPS. 19180020 BO SDACTXII NO--DONE--SOLID ERROR. 19190020 LA REGE,15 15 PASSES THRU LOOP2X. 19200020 LA REGF,6 6 PASSES OF LOOP2X AND LOOP3X. 19210020 B LOOP2X REPEAT UNTIL NO ERROR OR 226. 19220020 SPACE 1 19230020 SDACTXII MVI ACTXIISW,X'00' TURN OFF THE CONTROL SWITCH. 19240020 BR LINK1 SOLID ERROR--RETURN. 19250020 SPACE 1 19260020 EIGHTTRY LA REGG,8 SET UP FOR EIGHT SWEEPS. 19270020 LA CCWREG,HILOWCCW CCW LIST FOR LAST-FIRST TRACKS. 19280020 LOOP4X BAL LINK9,STARTIO SWEEP FROM LAST TO FIRST TRACKS. 19290020 BCT REGG,LOOP4X REPEAT FOR EIGHT SWEEPS. 19300020 BR LINK15 RETURN 19310020 EJECT 19320020 HILOWCCW CCW 7,HIADR,X'40',6 SEEK LAST TRACK OF STRIP. 19330020 CCW 7,LOWADR,X'00',6 SEEK FIRST TRACK OF STRIP. 19340020 SPACE 1 19350020 SNXTLOW CCW 7,NXTLOW,X'00',6 SEEK NEXT LOWER OR STRIP ONE. 19360020 DS 0D 19370020 HIADR DC X'0000000004130000' SEEK ADDRESS FOR LAST TRACK. 19380020 LOWADR DC 1D'0' SEEK ADDRESS FOR FIRST TRACK. 19390020 NXTLOW DC X'000000000000' NEXT LOWER ADDRESS OR STRIP ONE. 19400020 EJECT 19410020 * ************************************************** 19420020 * * ROUTINES BELOW ARE COMMON TO DASD DEVICES * 19430020 * ************************************************** 19440020 SPACE 1 19450020 * SEEKED TO CORRECT CYLINDER ROUTINE 19460020 SPACE 1 19470020 CYLNCHK L GR7,4(UCBREG) GET SEEK CCW LIST ADDR. FROM CSW 19480020 L GR8,0(GR7) GET ADDRESS OF SEEK BBCCHH FLD. 19490020 MVC STORSEEK(4),2(GR8) SAVE ADDR. OF SEEKED TO LOCATION 19500020 LA GR3,READHOME GET ADDR. OF READ HOME ADDR. CCW 19510020 BAL LINK9,STARTIO DO READ HOME ADDRESS OPERATION. 19520020 CLC HOMEBUF+1(4),STORSEEK VERIFY SEEK TO PROPER CYLN. NUMB 19530020 BCR 7,LINK15 INCORRECT CYLINDER-RESEEK HEADS 19540020 BC 8,4(LINK15) CORRECT CYLINDER- ERROR RETURN 19550020 SPACE 1 19560020 STORSEEK DC 3H'0' SAVE AREA FOR SEEK TO CCHH FLD. 19570020 SPACE 1 19580020 DS 0D DOUBLE WORD BOUNDARY 19590020 READHOME DC X'1A' READ HOME ADDRESS OP. CODE 19600020 DC AL3(HOMEBUF) ADDRESS OF READIN BUFFER 19610020 DC X'20000005' COUNT OF 5/////SILI BIT ON///// 19620020 SPACE 1 19630020 HOMEBUF DC XL5'00' BUFFER FOR READ H/A FIVE BYTES 19640020 SPACE 19650020 TWOSEEK LA CSR3,WIPEHEAD ADDRESS OF RESTORE CCW 19660020 CLI 0(UCBREG),X'03' IS THIS FOR 2302 19670020 BNE TWOSEEK1 NO 19680020 LA CSR3,SEEK2302 YES--SEEK CYLINDER 251 19690020 MVI ACTXIISW,X'10' SET FOR DIRECT RETURN 19700020 BAL LINK9,STARTIO SEEK CE CYLINDER 19710020 MVI ACTXIISW,X'00' RESET DIRECT RETURN SW 19720020 LA CSR3,SEEKZERO SEEK TO ZERO CCW 19730020 TWOSEEK1 BAL LINK9,STARTIO PERFORM SEEK CCW LIST 19740020 BAL LINK15,TWOTRY RETRY ERROR CCW LIST TWO TIMES 19750020 BR LINK1 RETURN TO CALLING ROUTINE 19760020 TRESEEK LA GR3,WIPEHEAD ADDRESS OF RESTORE CCW 19770020 BAL LINK9,STARTIO PERFORM RESTORE 19780020 BAL LINK15,TRETRY RETRY CCW LIST AND SEEK 3 TIMES 19790020 BR LINK1 SOLID ERROR//..//RETURN//.... 19800020 SPACE 1 19810020 TENSEEK LA CSR3,WIPEHEAD ADDRESS OF HEAD CLEAN CCW LIST 19820020 CLI 0(UCBREG),X'03' IS THIS FOR 2302 19830020 BNE TENSEEK1 NO 19840020 LA CSR3,SEEK2302 YES,SEEK CYLINDER 251 19850020 MVI ACTXIISW,X'10' SET FOR DIRECT RETURN 19860020 BAL LINK9,STARTIO SEEK CE CYLINDER 19870020 MVI ACTXIISW,X'00' RESET DIRECT RETURN SWITCH. 19880020 LA GR3,SEEKZERO SEEK TO ZERO CCW. 19890020 TENSEEK1 BAL LINK9,STARTIO PERFORM A SEEK. 19900020 BAL LINK15,TENTRY RETRY ERROR CCW LIST 10 TIMES 19910020 BR LINK1 RETURN TO CALLING ROUTINE. 19920020 SPACE 1 19930020 DS 0D 19940020 WIPEHEAD CCW X'13',0,X'60',1 RESTORE COMMAND 2311 19950020 CCW X'17',0,X'20',1 2321 19960020 SPACE 1 19970020 SEEK2302 CCW 7,SEEK251,X'00',6 SEEK CYLINDER 251 19980020 SEEKZERO CCW 7,CLEAR,X'00',6 SEEK CYLINDER ZERO 19990020 SPACE 1 20000020 SEEK251 DC X'000000FB0000' SEEK TO CYL 251 BBCCHH FIELD 20010020 SPACE 1 20020020 * TRACK OVERRUN ERROR ROUTINE 20030020 SPACE 1 20040020 TROVRRUN LA ERREG1,EMES14 INDEX TO MESSAGE TABLE. 20050020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 20060020 SPACE 1 20070020 SPACE 1 20080020 * DASD OVERFLOW ERROR ROUTINE 20090020 SPACE 1 20100020 OVRFLOW LA ERREG1,EMES23 INDEX TO MESSAGE TABLE 20110020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 20120020 SPACE 1 20130020 * FILE PROTECTED ERROR ROUTINE 20140020 SPACE 1 20150020 FILEPROT LA ERREG1,EMES15 INDEX TO MESSAGE TABLE 20160020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 20170020 SPACE 1 20180020 * INVALID ADDRESS ERROR ROUTINE 20190020 SPACE 1 20200020 INVLDADR LA ERREG1,EMES10 INDEX TO MESSAGE TABLE 20210020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 20220020 SPACE 1 20230020 * SEEK CHECK ROUTINE 20240020 SPACE 1 20250020 SEEKCHK LA ERREG1,EMES30 INDEX TO MESSAGE TABLE 20260020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 20270020 SPACE 1 20280020 * NO RECORD FOUND ERROR ROUTINE 20290020 SPACE 1 20300020 NORECFND CLI NORCDSW,X'F0' IS THIS A LABEL CHECK ROUTINE. 20310020 BC 7,NORECMSG NO-GO TO PRINT ERROR MSG RTN. 20320020 LM 0,15,ERRSAV1 YES-RESTORE REGISTERS FOR RETURN 20330020 B RCDRTN GO TO NO LABEL FOUND ROUTINE. 20340020 SPACE 1 20350020 NORECMSG LA ERREG1,EMES17 INDEX TO MESSAGE TABLE. 20360020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 20370020 SPACE 1 20380020 * END OF CYLINDER ERROR ROUTINE 20390020 SPACE 1 20400020 ENDOFCYL LA ERREG1,EMES09 INDEX TO MESSAGE TABLE 20410020 * INVALID TRACK FORMAT ERROR 20420020 INTRKFMT LA ERREG1,EMES37 INDEX TO MESSAGE TABLE S20201 20430020 B ERROROUT PRINT ERROR MSG S20201 20440020 SPACE 1 20450020 * MISSING ADDRESS MARKER ERROR ROUTINE. 20460020 SPACE 1 20470020 MISSMARK LA ERREG1,EMES34 INDEX TO MESSAGE TABLE. 20480020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 20490020 SPACE 1 20500020 BLANKTRK LA ERREG1,EMES35 BLANK TRACK 20510020 B ERROROUT 20520020 SPACE 1 20530020 INDEXRTN MVI ERRETRY,X'00' RESET ERROR RETRY SWITCH OFF 20540020 MVI DSKEOFSW,X'00' RESET DISK EOF SWITXH. 5434 20550020 MVI ACTXIISW,X'00' RESET ACTION XII SWITCH 20560020 MVI 1(UCBREG),X'00' TURN OFF THE FLAG. 20570020 MVI SAVEPSW+1,X'04' TURN OFF WAIT BIT 20580020 LA GR7,TENCK PGM LOOP CHECK OX00110 20582002 L GR8,SAVEPSW+4 BRANCH ADDRESS OX00110 20584002 LA GR8,0(GR8) ZERO HIGH BYTE OX00110 20586002 CLR GR7,GR8 COMPARE PSW ADDRESS OX00110 20588002 LM 0,15,ERRSAV1 RESTORE THE REGISTERS. 20590020 BE RESET15 END OF TAPE OX00110 20592002 LPSW SAVEPSW RETURN TO PROCESS. 20600020 EJECT 20610020 * ************************************************** 20620020 * * ROUTINES BELOW ARE COMMON TO TAPE DEVICES * 20630020 * ************************************************** 20640020 SPACE 2 20650020 * TEST TAPE DATA CHECK==READ OR WRITE? 20660020 SPACE 1 20670020 TAPEDATA TM 25(UCBREG),X'04' TAPE IN READ OR WRITE STATUS? 20680020 BC 14,NOISETST READ STATUS-PERFORM NOISE CHECK 20690020 SPACE 1 20700020 * TAPE DATA CHECK ON WRITE ROUTINE 20710020 SPACE 1 20720020 RITERROR BAL LINK15,BACKSPC BACKSPACE TAPE ONE RECORD 20730020 BAL LINK15,ERASE ERASE ONE LONG GAP ON TAPE 20740020 BAL LINK15,TENTRY RETRY TEN TIMES 7849 20750020 LA ERREG1,EMES31 INDEX TO MESSAGE TABLE 20760020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 20770020 SPACE 1 20780020 * TAPE BACKSPACE ROUTINE 20790020 SPACE 1 20800020 BACKSPC LA CSR3,BSPACE GET ADDRESS OF BACKSPACE SSW 20810020 BAL LINK9,STARTIO PERFORM BACKSPACE OPERATION. 20820020 BCR 15,LINK15 RETURN TO CALLING ROUTINE 20830020 SPACE 1 20840020 DS 0D DOUBLE WORD BOUNDARY 20850020 BSPACE DC X'27' OP CODE FOR BACKSPACE 20860020 DC X'00000020000001' REMAINDER OF CCW 20870020 SPACE 1 20880020 * TAPE ERASE ONE LONG GAP ROUTINE 20890020 SPACE 1 20900020 ERASE LA CSR3,ERASEGAP GET ADDRESS OF ERASE CCW LIST. 20910020 BAL LINK9,STARTIO PERFORM ERASE OPERATION. 20920020 BR LINK15 RETURN TO CALLING ROUTINE 20930020 SPACE 1 20940020 DS 0D 20950020 ERASEGAP DC X'17' OP CODE FOR ERASE 20960020 DC X'00000020000001' REMAINDER OF CCW 20970020 SPACE 1 20980020 * TAPE AT LOAD POINT ROUTINE 20990020 SPACE 1 21000020 TAPELP TM LPSWITCH,X'EE' LP OCCURED DURING TAPECLN RTN. 21010020 BC 1,LPDATA YES--GO TO DATA CHECK AT LP EXIT 21020020 LA ERREG1,EMES32 NO- INDEX TO THE MESSAGE TABLE 21030020 B ERROROUT PRINT ERROR MESSAGE//TERMINATE. 21040020 SPACE 1 21050020 LPSWITCH DC X'00' SWITCH AT 'EE'//DATA CHECK AT LP 21060020 EJECT 21070020 * TAPE READ DATA CHECK////NOISE RECORD ERROR ROUTINE. 21080020 SPACE 1 21090020 NOISETST TM CKVOLSW,X'20' IS ERR ON INIT LABEL A27583 21100020 BC 14,NOTLABEL NO-GO TO STANDARD READ ERROR RTN 21110020 SPACE 1 A27583 21120020 * DATA CHECK WHILE READING FIRST RECORD ON TAPE, A27583 21130020 * CANNOT READ AS LABEL, ASSUME LOADER (LABEL IS A27583 21140020 * VARIABLE MODE, LOADER IS DEFAULT MODE) A27583 21150020 LM 0,15,ERRSAV1 YES---RESTORE P/P REGISTERS. 21160020 XI CKVOLSW,X'20' TURN OFF INITIAL A27583 21170020 * LABEL SWITCH A27583 21180020 TM TAPEBUFS+1,X'10' IS TAPE 7 TRACK A27583 21190020 BNO RETRYLBL NO, KEEP MODE A27583 21200020 MVI XRDVOLID,X'93' LOADER DEFAULT MODE A27583 21210020 RETRYLBL MVI ERRETRY,X'00' TURN OFF ERROR SW A27583 21220020 LA RCAW,XREWCCW REWIND TAPE A27583 21230020 BAL RLINK1,STARTIO A27583 21240020 BR RWRKREG4 RETRY LOADER A27583 21250020 SPACE 1 21260020 NOTLABEL L GR7,16(UCBREG) ADDR. OF CCW AFTER READ ERROR. 21270020 S GR7,EIGHT GET ADDRESS OF ERROR CCW 21280020 MVC TIECCW1(8),0(GR7) LOAD ERROR CCW IN TIE CCW LIST 21290020 LH GR8,6(GR7) LOAD COUNT OF ERROR CCW IN REG 8 21300020 SH GR8,22(UCBREG) GET NUMBER OF BYTES READ 21310020 CH GR8,TWELVE TEST FOR TWELVE BYTES 21320020 BC 10,READTAPE 12 BYTES OR MORE RECORD LENGTH 21330020 TM 25(UCBREG),X'80' LESS THAN 12BYTE-CHECK NOISE BIT 21340020 BC 7,READTAPE NOISE BIT ON--GO TO READTAPE RTN 21350020 NOISEREC MVI ERRETRY,X'00' TURN OFF ERROR RETRY SWITCH 21360021 SPACE 1 21370020 LM 0,15,ERRSAV1 RESTORE REGISTERS FOR RETURN. 21380021 B STARTIO1 IGNORE NOISE REC--GET NEXT REC. 21390020 SPACE 1 21400020 READTAPE BAL LINK15,BACKSPC BACKSPACE TAPE ONE RECORD 21410020 L GR7,READTEN SETUP COUNTER FOR READ RETRYS 21420020 BCT GR7,READLOOP PERFORM 10 RETRYS IF ERROR CONTS 21430020 TM 25(UCBREG),X'08' IS THE TAPE AT LOAD POINT. 21440020 BC 1,NOCLEAN YES--BYPASS TAPE CLEANER ROUTINE 21450020 SPACE 1 21460020 MVI LPSWITCH,X'EE' SET LP SW ON TO DETECT BS TO LP. 21470020 BAL LINK15,TAPECLN LINK TO TAPE CLEANER ROUTINE 21480020 MVI LPSWITCH,X'00' RESET LP SWITCH TO OFF. 21490020 SPACE 1 21500020 NOCLEAN L GR8,CLEANCTR SET UP TAPE CLEANER ENTRY CTR. 21510020 BCT GR8,CLEANLOP BR-ALLOW TEN ENTRYS INTO TAPECLN 21520020 SPACE 1 21530020 LPDATA MVC READTEN(4),READSET SOLID ERROR//RESET COUNTER TO 10 21540020 MVC CLEANCTR(4),CLEANSET 10TH ENTRY TO TAPE CLEANER/RESET 21550020 MVI LPSWITCH,X'00' RESET LOAD POINT SWITCH OFF. 21560020 LA ERREG1,EMES12 INDEX TO MESSAGE TABLE 21570020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 21580020 SPACE 1 21590020 CLEANLOP ST GR8,CLEANCTR SAVE DECREMENTED COUNTER VALUE 21600020 L GR7,READSET 10TH READ RETRY--RESET READTEN. 21610020 SPACE 1 21620020 READLOOP ST GR7,READTEN SAVE DECREMENTED COUNTER VALUE 21630020 MVC TIEBYTE(1),26(UCBREG) PUT SENSE BYTE 2 IN TIE CCW LIST 21640020 MVI ERRETRY,X'FF' TURN ERROR RETRY SWITCH ON. 21650020 LA CSR3,TIECCW LOAD TRACK IN ERROR CCW LIST ADR 21660020 BAL LINK9,STARTIO EXECUTE T.I.E. CCW LIST. 21670020 MVC READTEN(4),READSET NO ERROR RETURN--RESET COUNTER. 21680020 MVC CLEANCTR(4),CLEANSET NO ERROR RETURN--RESET COUNTER. 21690020 B INDEXRTN RESET SWITCHES AND RETURN 21700020 SPACE 1 21710020 DS 0D 21720020 TIECCW DC X'1B' TRACK IN ERROR COMMAND CODE. 21730020 DC AL3(TIEBYTE) ADDRESS OF TRACK IN ERROR BYTE 21740020 DC X'60000001' CHAIN BIT ON//SLI BIT ON// 21750020 TIECCW1 DC X'0000000000000000' SPACE FOR INSERTING READ CCW . 21760020 SPACE 1 21770020 TIEBYTE DC X'00' SPACE TO INSERT SENSE BYTE TWO. 21780020 SPACE 1 21790020 DS 0F 21800020 READTEN DC X'0000000A' COUNT OF RETRYS 21810020 READSET DC X'0000000A' RESTORE VALUE 21820020 CLEANCTR DC X'0000000A' COUNT OF TAPE CLEANER ENTRYS 21830020 CLEANSET DC X'0000000A' RESTORE VALUE 21840020 SPACE 1 21850020 DS 0F FULL WORD ALIGNMENT 21860020 SIXTEEN DC 1F'16' 'SIXTEEN' ON FULL WORD BOUNDRY. 21870020 TWELVE DC H'12' HALF WORD OF 12 21880020 SPACE 1 21890020 * TAPE CLEANER ROUTINE 21900020 SPACE 1 21910020 TAPECLN LA CSR3,CLEANTP GET ADDRESS OF TAPE CLEANER CCWS 21920020 BAL LINK9,STARTIO PERFORM TAPE CLEANER ROUTINE. 21930020 BR LINK15 RETURN TO CALLING ROUTINE 21940020 SPACE 1 21950020 DS 0D 21960020 CLEANTP DC X'27' BACKSPACE OP CODE 21970020 DC X'00000060000001' CHAIN BIT ON///SLI BIT ON// 21980020 DC X'27' BACKSPACE OP CODE 21990020 DC X'00000060000001' CHAIN BIT ON///SLI BIT ON// 22000020 DC X'37' FORWARD SPACE OP CODE 22010020 DC X'00000060000001' CHAIN BIT ON///SLI BIT ON// 22020020 DC X'37' FORWARD SPACE OP CODE 22030020 DC X'00000020000001' CHAIN BIT OFF//SLI BIT ON// 22040020 EJECT 22050020 * ************************************************** 22060020 * * ROUTINES BELOW USED FOR ALL I/O ERROR RETRYS. * 22070020 * ************************************************** 22080020 SPACE 2 22090020 * TWO RETRYS OF ERROR CCW ROUTINE 22100020 SPACE 1 22110020 TWOTRY TM TWOFLAG,X'02' IS THIS SECOND ENTRY INTO TWOTRY 22120020 BC 1,BADTRY YES. GO TO PERMANENT ERROR EXIT. 22130020 MVI TWOFLAG,X'02' NO...SET TWOFLAG TO ON. 22140020 L CSR3,4(UCBREG) GET ADDRESS OF START OF CCW LIST 22150020 BAL LINK9,STARTIO RETRY CCW LIST ONCE MORE. 22160020 MVI TWOFLAG,X'00' RETRY OK--SET TWOFLAG TO OFF. 22170020 B INDEXRTN RESET SWITCHES AND RETURN 22180020 SPACE 1 22190020 BADTRY MVI TWOFLAG,X'00' PERMANENT ERROR//SET TWOFLAG OFF 22200020 BR LINK15 SOLID ERROR----//RETURN//--- 22210020 SPACE 1 22220020 TWOFLAG DC X'00' '00' EQUAL OFF/// '02' EQUAL ON. 22230020 SPACE 1 22240020 SPACE 1 22250020 * THREE ERROR RETRYS ROUTINE. 22260020 SPACE 1 22270020 TRETRY L GR7,TRECTR SETUP COUNTER FOR RETRY 22280020 BCT GR7,TRELOOP BR--ALLOW UP TO THREE RETRYS-- 22290020 MVC TRECTR(4),TRESET 3RD RETRY ERROR--RESET COUNTER 22300020 BR LINK15 SOLID ERROR----//RETURN//---- 22310020 SPACE 1 22320020 TRELOOP ST GR7,TRECTR SAVE DECREMENTED COUNTER TOTAL 22330020 L CSR3,4(UCBREG) ADDRESS OF CCW LIST IN ERROR 22340020 BAL LINK9,STARTIO RETRY CCW LIST ONCE MORE. 22350020 MVC TRECTR(4),TRESET NO ERROR RETURN-SET COUNTER TO 3 22360020 B INDEXRTN RESET SWITCHES AND RETURN 22370020 SPACE 1 22380020 DS 0F 22390020 TRECTR DC XL4'00000004' COUNT OF RETRYS PLUS ONE 7849 22400020 TRESET DC XL4'00000004' RESTORE VALUE 7849 22410020 EJECT 22420020 * SIX ERROR RETRYS ROUTINE 22430020 SPACE 1 22440020 SIXTRY L GR7,SIXCTR SETUP COUNTER FOR RETRY 22450020 BCT GR7,SIXLOOP BR--ALLOW UP TO FIVE RETRYS-- 22460020 MVC SIXCTR(4),SIXSET 6TH ERROR--RESET COUNTER 22470020 BR LINK15 SOLID ERROR----//RETURN//--- 22480020 SPACE 1 22490020 SIXLOOP ST GR7,SIXCTR SAVE DECREMENTED COUNTER TOTAL 22500020 L CSR3,4(UCBREG) ADDRESS OF CCW LIST IN ERROR. 22510020 BAL LINK9,STARTIO RETRY CCW LIST ONCE MORE. 22520020 MVC SIXCTR(4),SIXSET NO ERROR RETURN-SET COUNTER TO 5 22530020 B INDEXRTN RESET SWITCHES AND RETURN 22540020 SPACE 1 22550020 DS 0F 22560020 SIXCTR DC X'00000005' COUNT OF RETRYS 22570020 SIXSET DC X'00000005' RESTORE VALUE 22580020 SPACE 1 22590020 * TEN RETRYS OF ERROR CCW LIST ROUTINE 22600020 SPACE 1 22610020 TENTRY L GR7,TENCTR SETUP COUNTER FOR RETRY 22620020 BCT GR7,TENLOOP BR--ALLOW UP TO TEN RETRYS-- 22630020 MVC TENCTR(4),TENSET 10TH ERROR--RESET COUNTER-- 22640020 BR LINK15 SOLID ERROR----//RETURN//--- 22650020 SPACE 1 22660020 TENLOOP ST GR7,TENCTR SAVE DECREMENTED COUNTER TOTAL 22670020 L CSR3,4(UCBREG) ADDRESS OF CCW LIST IN ERROR 22680020 BAL LINK9,STARTIO RETRY CCW LIST ONCE MORE. 22690020 TENCK MVC TENCTR(4),TENSET NO ERR. RETURN-SET COUNTER TO 10 22700021 B INDEXRTN RESET SWITCHES AND RETURN 22710020 SPACE 1 22720020 DS 0F 22730020 TENCTR DC XL4'0000000B' COUNT OF RETRYS PLUS ONE 7849 22740020 TENSET DC XL4'0000000B' RESTORE VALUE 7849 22750020 SPACE 22760020 * SIXTEEN BY SIXTEEN ERROR RETRY ROUTINE. 22770020 SPACE 1 22780020 SIXTTRY LH GR7,RECALCTR PICK UP COUNTER VALUE. 22790020 BCT GR7,SIXTLOOP RECALIBRATE AFTER 16 ENTRIES. 22800020 LA GR3,WIPEHEAD RECALIBRATE CCW. 22810020 CLI 0(UCBREG),X'03' IS THIS A 2302. 22820020 BNE SIXTEENS NO--GO PERFORM RECALIBRATE. 22830020 LA GR3,SEEKZERO YES-SET UP FOR SEEK TO ZERO. 22840020 SIXTEENS BAL LINK9,STARTIO POSITION DEVICE TO ZERO. 22850020 LA GR7,17 VALUE TO RESET COUNTER. 22860020 SIXTLOOP STH GR7,RECALCTR STORE NEW COUNTER VALUE. 22870020 LH GR7,CTR16 PICK UP RETRY VALUE. 22880020 BCT GR7,S16LOOP HAVE WE RETRIED 256 TIMES. 22890020 MVC CTR16(4),RESET YES-SOLID ERROR/RESET COUNTERS. 22900020 BR LINK15 RETURN TO CALLER. 22910020 S16LOOP STH GR7,CTR16 STORE NEW COUNTER VALUE. 22920020 L GR3,4(UCBREG) CCW LIST IN ERROR. 22930020 BAL LINK9,STARTIO RETRY CCW LIST ONCE MORE. 22940020 MVC CTR16(4),RESET NO ERROR//RESET COUNTERS. 22950020 B INDEXRTN ERROR RECOVERY RETURN. 22960020 CTR16 DC H'257' COUNT OF RETRIES. 22970020 RECALCTR DC H'17' RECALIBRATE COUNT. 22980020 RESET DC H'257' RESTORE VALUE. 22990020 BUFCCW CCW X'24',SAVECC1,X'30',128 READ BUFFER LOG S20201 23000020 SAVECCW DC H'0' SAVE ADDR OF CCW S20201 23010020 SAVECC1 DC F'0' READ BUFLOG AREA S20201 23020020 EJECT 23030020 * ***************************************************** 23040020 * * ROUTINES BELOW USED FOR OPERATOR ALERT ROUTINES. * 23050020 * ***************************************************** 23060020 SPACE 1 23070020 * TYPE OPERATOR MESSAGE//WAIT ROUTINE 23080020 SPACE 1 23090020 DEVWAIT LA GR1,50 LENGTH OF MESSAGE IN BYTES. 23100020 LA GR2,READYDEV ADDRESS OF READYDEV MESSAGE. 23110020 SPACE 1 23120020 TYPEWAIT BAL LINK15,OPPRNT LINK TO I/O WRITER PRINT MESSAGE 23130020 SPACE 1 23140020 WAITTRY LA GR7,STARTIO1 SET UP RETURN ADDRESS. 23150020 ST GR7,CONTINUE+4 MODIFY CONTINUE REENTRY POINT 23160020 MVI ERRETRY,X'00' TURN OFF ERROR RETRY SWITCH 23170020 LM 0,15,ERRSAV1 RESTORE REGS TO RETRY ORIG. CCW. 23180020 LPSW IOWAIT REENTER STARTIOX ON READY DEVICE 23190020 SPACE 2 23200020 READYRDR DC C'IBC154A READY READER . ' 23210020 SPACE 1 23220020 READCHK DC C'IBC159A READER CHECK. CORRECT ERROR. DEPRESS ' 23230020 DC C'INTERRUPT KEY.' 23240020 SPACE 1 23250020 READYPRT DC C'IBC155A READY PRINTER .' 23260020 SPACE 1 23270020 PRINTCHK DC C'IBC160A PRINT CHECK. CORRECT ERROR. DEPRESS ' 23280020 DC C'INTERRUPT KEY.' 23290020 SPACE 1 23300020 INVALCRD DC C'IBC101W INVALID CARD CODE. CORRECT ERROR. ' 23310020 DC C'DEPRESS INTERRUPT KEY.' 23320020 SPACE 1 23330020 TYPEFAIL DC C'IBC153A TYPEWRITER FAILED TO READ LAST MESSAGE. ' 23340020 DC C' DEPRESS INTERRUPT KEY.' 23350020 SPACE 1 23360020 READYDEV DC C' DEPRESS INTERRUPT KEY.' 23370020 SPACE 1 23380020 DISKMSG DC C'IBC157A READY DASD . ' 23390020 SPACE 1 23400020 TAPEMSG DC C'IBC156A READY TAPE . ' 23410020 SPACE 1 23420020 GETTAPE DC C'IBC166A NOT A RESTORE VOL. ON . MOUNT PROPER' 23430020 DC C' VOLUME. DEPRESS INTERRUPT KEY.' 23440020 SPACE 1 23450020 GETCELL DC C'IBC167A SEEKED BALLAST CELL. MOUNT PROPER CELL.' 23460020 DC C' DEPRESS INTERRUPT KEY.' 23470020 EJECT 23480020 * CONVERT UNIT INTERFACE ADDRESS TO EBDIC FOR PRINTING. 23490020 SPACE 2 23500020 UNITADDR UNPK UNITBUF(5),2(3,GR7) UNPACK CHANNEL AND UNIT ADDRESS. 23510020 TR UNITBUF(4),IOTAB-240 TRANSULATE TO BCD. 23520020 BR LINK15 RETURN TO USER. 23530020 SPACE 2 23540020 UNITBUF DS 1D BUFFER FOR EBDIC UNIT ADDRESS. 23550020 SPACE 2 23560020 SPACE 2 23570020 * MOUNT PROPER TAPE MESSAGE HANDLING ROUTINE. 23580020 SPACE 1 23590020 MOUNTAPE LA GR7,UCBFRM ADDRESS OF FROM DEVICE UCB. 23600020 BAL LINK15,UNITADDR CONVERT INTERFACE ADDRESS TO BCD 23610020 MVC GETTAPE+31(3),UNITBUF+1 PUT DEVICE ADDRESS IN MESSAGE. 23620020 LA GR2,GETTAPE GET ADDRESS OF GETTAPE MESSAGE. 23630020 LA GR1,80 MESSAGE LENGTH. 23640020 B TYPEWAIT GO TO PRINT MESSAGE//WAIT ROUTIN 23650020 EJECT 23660020 * ************************************************** 23670020 * * ROUTINES BELOW ARE COMMON TO ALL I/O DEVICES * 23680020 * ************************************************** 23690020 SPACE 2 23700020 * PRINT ERROR MESSAGE AND TERMINATE ROUTINE. 23710020 SPACE 1 23720020 ERROR0F MVI 115,X'0F' INDICATE I/O CHANNEL FAILURE 23730020 B SEREPEND GO TO ERROR END TERMINATE. 23740020 SPACE 1 23750020 ERROROUT MVI 115,X'1F' INDICATE IO DEVICE FAILURE 23760020 SPACE 1 23770020 SEREPEND MVC 58(2),2(UCBREG) PUT CHANNEL AND UNIT IN I/O PSW 23780020 MVC SEREPSAV(28),48 SAVE OLD MC,I/O PSW,CSW, CAW 23790020 MVC 24(6),24(UCBREG) SAVE SENSE BYTES FOR SEREP 23800020 SPACE 1 23810020 BAL LINK9,IOPRNT LINK TO PRINT MESSAGE ROUTINE 23820020 MVC PRWD(36),ENDMESS ADDRESS OF I/O ERROR END MESSAGE 23830020 LA GR1,36 LENGTH OF MESSAGE IN BYTES. 23840020 BAL LINK9,PRNT PRINT I/O ERROR TERMINATE. 23850020 SPACE 1 23860020 MVC 48(28),SEREPSAV RESTORE OLD MC,I/O PSW//CSW/CAW 23870020 LM 0,15,ERRSAV1 RESTORE REGISTERS FOR SEREP 23880020 LPSW COWAIT TERMINATE. 23890020 SPACE 1 23900020 ENDMESS DC C'IBC249W I/O ERROR. JOB TERMINATED.' 23910020 SPACE 1 23920020 * START I/O ERROR ROUTINE 23930020 SPACE 1 23940020 SIOERR LA ERREG1,EMES11 INDEX TO MESSAGE TABLE 23950020 MVI 115,X'3F' INDICATE DEVICE NOT OPERATIONAL 23960020 MVI UCBSYO,X'00' FORCE MESSAGE TO CONSOLE. 23970020 B SEREPEND GO TO ERROR END TERMINATE 23980020 SPACE 1 23990020 * CHANNEL CONTROL CHECK ROUTINE 24000020 SPACE 1 24010020 CHANERR LA ERREG1,EMES20 INDEX TO MESSAGE TABLE 24020020 B ERROR0F GO TO SEREP INTERFACE. SET X'0F 24030020 SPACE 1 24040020 * INTERFACE CONTROL CHECK ROUTINE 24050020 SPACE 1 24060020 INFCERR LA ERREG1,EMES21 INDEX TO MESSAGE TABLE 24070020 B ERROR0F GO TO SEREP INTERFACE. SET X'0F 24080020 SPACE 1 24090020 * CHANNEL DATA CHECK ROUTINE 24100020 SPACE 1 24110020 CHDATA LA ERREG1,EMES22 INDEX TO MESSAGE TABLE 24120020 B ERROR0F GO TO SEREP INTERFACE. SET X'0F 24130020 SPACE 1 24140020 * PROGRAM CHECK ROUTINE 24150020 SPACE 1 24160020 PROCHK LA ERREG1,EMES24 INDEX TO MESSAGE TABLE 24170020 B ERROR0F GO TO SEREP INTERFACE. SET X'0F 24180020 EJECT 24190020 * PROTECTION CHECK ROUTINE 24200020 SPACE 1 24210020 PTNCHK LA ERREG1,EMES25 INDEX TO MESSAGE TABLE 24220020 B ERROR0F GO TO SEREP INTERFACE. SET X'0F 24230020 SPACE 1 24240020 * UNIT EXCEPTION ROUTINE 24250020 SPACE 1 24260020 UNITCEPT CL UCBREG,INPUTR WAS THE UNIT EXCEPTION ON SYSIN 9930 24270020 BE ABSEQPRT IF SO, GO PRNT CARD SEQ ERR MSG 9930 24280020 LA ERREG1,EMES26 INDEX TO MESSAGE TABLE 9930 24290020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 24300020 SPACE 1 24310020 * INCORRECT LENGTH ERROR ROUTINE. 24320020 SPACE 1 24330020 WLRERR LA ERREG1,EMES27 INDEX TO MESSAGE TABLE 24340020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 24350020 SPACE 1 24360020 * CHAINING CHECK ROUTINE 24370020 SPACE 1 24380020 CHAINCHK CLI ZERR(UCBREG),T1402 IS DEVICE A 1402 S20201 24390020 BE NEVER SHOULD NOT OCCUR S20201 24400020 LA ERREG1,EMES28 INDEX TO MSG TABLE S20201 24410020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 24420020 SPACE 1 24430020 * EQUIPMENT CHECK ROUTINE 24440020 SPACE 1 24450020 EQUIPCHK LA ERREG1,EMES04 INDEX TO MESSAGE TABLE 24460020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 24470020 SPACE 1 24480020 * DATA CHECK ROUTINE 24490020 SPACE 1 24500020 DATACHK LA ERREG1,EMES05 INDEX TO MESSAGE TABLE 24510020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 24520020 SPACE 1 24530020 * COMMAND REJECT ROUTINE 24540020 SPACE 1 24550020 COMREJ LA ERREG1,EMES01 INDEX TO MESSAGE TABLE 24560020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 24570020 SPACE 1 24571020 * WRITE INHIBIT ROUTINE M4698 24572020 SPACE 1 24573020 INHIBIT LA ERREG1,EMES43 MESSAGE INDEX M4698 24574020 B ERROROUT PRINT MSG/ TERMINATE M4698 24575020 SPACE 1 24576020 SPACE 1 24580020 * END OF TEST ROUTINE 24590020 SPACE 1 24600020 ENDTEST LA ERREG1,EMES18 INDEX TO MESSAGE TABLE 24610020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 24620020 SPACE 1 24630020 * SHOULD NOT OCCUR ROUTINE 24640020 SPACE 1 24650020 NEVER LA ERREG1,EMES19 INDEX TO MESSAGE TABLE 24660020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 24670020 SPACE 1 24680020 * INTERVENTION REQUIRED ROUTINE 24690020 SPACE 1 24700020 INTVREQ LA ERREG1,EMES02 INDEX TO MESSAGE TABLE 24710020 BAL LINK9,IOPRNT LINK TO PRINT MESSAGE 24720020 BR LINK15 WRITE MESSAGE EXECUTED//RETURN. 24730020 SPACE 1 24740020 * SEEKED BALLAST CELL 24750020 SPACE 1 24760020 BALLAST LA GR2,GETCELL SEEKED BALLAST MESSAGE. 24770020 LA GR1,71 MESSAGE LENGTH. 24780020 B TYPEWAIT PRINT MESSAGE//AWAIT INTERRUPT. 24790020 EJECT 24800020 * *************************************************** 24810020 * * ECF FOR 2305 AND 3330 DEVICES * 24820020 * *************************************************** 24830020 ECFTEST STM 0,15,REGSAVE SAVE REGISTERS S20201 24840020 L 7,NEWBASE GET NEW BASE ADDR S20201 24850020 USING ECFCODE,7 SET NEW BASE S20201 24860020 BAL GR8,ECFCODE S20201 24870020 ECFRTN EQU * CONNECTOR M3390 24875020 DROP 7 S20201 24880020 B INDEXRTN RETURN TO PROCESS S20201 24890020 REGSAVE DC 16F'0' REGISTER SAVE AREA S20201 24900020 NEWBASE DC A(ECFCODE) NEW BASE REG VALUE S20201 24910020 EJECT 24920020 * BUS OUT CHECK ROUTINE 24930020 SPACE 1 24940020 BUSOUT LA ERREG1,EMES03 INDEX TO MESSAGE TABLE 24950020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 24960020 SPACE 1 24970020 * OVERRUN CHECK ROUTINE 24980020 SPACE 1 24990020 OVRRUN LA ERREG1,EMES06 INDEX TO MESSAGE TABLE 25000020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 25010020 SPACE 1 25020020 * UNUSUAL COMMAND SEQUENCE ROUTINE 25030020 SPACE 1 25040020 SEQERR LA ERREG1,EMES29 INDEX TO MESSAGE TABLE 25050020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 25060020 SPACE 1 25070020 * DATA CONVERTER CHECK ROUTINE 25080020 SPACE 1 25090020 CONVTERR LA ERREG1,EMES08 INDEX TO MESSAGE TABLE 25100020 B ERROROUT PRINT ERROR MESSAGE///TERMINATE. 25110020 SPACE 1 25120020 * CARRIAGE SKIP TO ONE ROUTINE 25130020 SPACE 1 25140020 SKIPTO1 LA GR3,CARSKIP ADDRESS OF CARRIAGE SKIP TO 1 CCW 25150020 MVI ERRETRY,X'FF' SET ERROR RETRY SWITCH ON 25160020 BAL LINK9,STARTIO PERFORM SKIP TO ONE CCW. 25170020 B INDEXRTN CCW EXECUTED//RETURN// 25180020 SPACE 1 25190020 DS 0D 25200020 CARSKIP DC X'8B' SKIP TO 1 COMMAND CODE 25210020 DC X'00000020000001' SLI BIT ON//COUNT OF 1// 25220020 SPACE 2 25230020 EJECT 25240020 * ***************************************************** 25250020 * * COMMON COMPUTER INTERRUPT ROUTINES ON THIS PAGE. * 25260020 * ***************************************************** 25270020 SPACE 2 25280020 * EXTERNAL INTERRUPT SUPERVISOR. 25290020 SPACE 1 25300020 EXTINT TM 27,X'40' WAS THIS A CONSOLE INTERRUPT 25310020 BC 8,EXTINT1 NO 25320020 MVI REQSW,X'FF' TURN ON REQUEST SWITCH A49361 25322002 LPSW CONTINUE YES - GO TO PRESET LOCATION 25330020 SPACE 1 25340020 SPACE 2 25350020 * PROGRAM INTERRUPT SUPERVISOR. 25360020 SPACE 1 25370020 PGMINT STM 0,15,REGSV2 SAVE REGISTERS 25380020 L BASE10,SYSBAS INSURE BASE REGISTER 10 5274 25390020 MVC SVPSW(8),40 SAVE OLD PROGRAM INTERRUPT PSW. 25400020 MVC PRWD(27),PGIERR LOAD ERROR MESSAGE IN PRINT FLD. 25410020 MVC PRWD+27(20),QUITJOB LOAD JOB TERMINATED MESSAGE 25420020 LA GR1,47 MESSAGE LENGTH IN BYTES. 25430020 BAL LINK9,PRNT GO TO PRINT ROUTINE. 25440020 LPSW COWAIT WAIT TERMINATE. 25450020 SPACE 1 25460020 PGIERR DC C'IBC152W PROGRAM INTERRUPT.' 25470020 SPACE 2 25480020 * SVC CALL INTERRUPT SUPERVISOR. 25490020 SPACE 1 25500020 SVCINT STM 0,15,REGSV2 SAVE REGISTERS 25510020 MVC SVPSW(8),32 SAVE OLD SVC INTERRUPT PSW. 25520020 MVC PRWD(23),ERRSVC LOAD ERROR MESSAGE IN PRINT FLD. 25530020 MVC PRWD+23(20),QUITJOB LOAD JOB TERMINATED MESSAGE. 25540020 LA GR1,43 MESSAGE LENGHT IN BYTES. 25550020 BAL LINK9,PRNT GO TO PRINT ROUTINE. 25560020 LPSW COWAIT WAIT TERMINATE. 25570020 SPACE 1 25580020 ERRSVC DC C'IBC104W SVC INTERRUPT.' 25590020 QUITJOB DC C' JOB TERMINATED. ' 25600020 EJECT 25610020 * ******************************************** 25620020 * * INDEXING FACTOR TO ERROR MESSAGE TABLE. * 25630020 * ******************************************** 25640020 SPACE 2 25650020 EMES01 EQU 0 COMMAND REJECT S20201 25660020 EMES02 EQU 20 INTERVENTION REQUIRED S20201 25670020 EMES03 EQU 40 BUS OUT CHECK S20201 25680020 EMES04 EQU 60 EQUIPMENT CHECK S20201 25690020 EMES05 EQU 80 DATA CHECK S20201 25700020 EMES06 EQU 100 OVER RUN CHECK S20201 25710020 EMES08 EQU 120 DATA CONVERTER CHECK S20201 25720020 EMES09 EQU 140 END OF CYLINDER S20201 25730020 EMES10 EQU 160 INVALID ADDRESS ERROR S20201 25740020 EMES11 EQU 180 NOT AVAILIABLE S20201 25750020 EMES12 EQU 200 TAPE READ DATA CHECK S20201 25760020 EMES37 EQU 220 INVALID TRK FORMAT S20201 25770020 EMES14 EQU 240 TRACK OVERRUN ERROR S20201 25780020 EMES15 EQU 260 FILE PROTECTED DEVICE S20201 25790020 EMES35 EQU 280 BLANK TRACK S20201 25800020 EMES17 EQU 300 DASD NO RECORD FOUND S20201 25810020 EMES18 EQU 320 END OF TEST TABLE S20201 25820020 EMES19 EQU 340 SHOULD NEVER OCCUR S20201 25830020 EMES20 EQU 360 CHANNEL CONTROL CHECK S20201 25840020 EMES21 EQU 380 INTERFACE CONTROL CHK S20201 25850020 EMES22 EQU 400 CHANNEL DATA CHECK S20201 25860020 EMES23 EQU 420 DASD OVERFLOW INCOMPLETE S20201 25870020 EMES24 EQU 440 PROGRAM CHECK S20201 25880020 EMES25 EQU 460 PROTECTION CHECK S20201 25890020 EMES26 EQU 480 UNIT EXCEPTION S20201 25900020 EMES27 EQU 500 INCORRECT LENGTH S20201 25910020 EMES28 EQU 520 CHAINING CHECK S20201 25920020 EMES29 EQU 540 INVALID COMMAND SEQUENCE S20201 25930020 EMES30 EQU 560 SEEK CHECK ERROR S20201 25940020 EMES31 EQU 580 TAPE WRITE DATA CHECK S20201 25950020 EMES32 EQU 600 TAPE AT LOAD POINT S20201 25960020 EMES34 EQU 620 MISSING ADDRESS MARKER S20201 25970020 EMES43 EQU 640 WRITE INHIBITED M4698 25975020 EJECT 25980020 * ********************************** 25990020 * * IOPRNT ERROR MESSAGE TABLE. * 26000020 * ********************************** 26010020 SPACE 2 26020020 ERRMSG DC C'01W COMMAND REJECT ' S20201 26030020 DC C'02A INTERV. REQUIRED' S20201 26040020 DC C'03W BUS OUT CHECK ' S20201 26050020 DC C'04W EQUIPMENT CHECK ' S20201 26060020 DC C'05W DATA CHECK ' S20201 26070020 DC C'06W OVER RUN ' S20201 26080020 DC C'08W DATA CONV. CHECK' S20201 26090020 DC C'09W END OF CYLINDER ' S20201 26100020 DC C'10W INVALID ADDRESS ' S20201 26110020 DC C'11W NOT AVAILIABLE ' S20201 26120020 DC C'12W READ DATA CHECK ' S20201 26130020 DC C'42W INVALID TRK FMT ' S20201 26140020 DC C'14W TRACK OVERRUN ' S20201 26150020 DC C'15W FILE PROTECTED ' S20201 26160020 DC C'35W BLANK TRACK ' S20201 26170020 DC C'17W NO RECORD FOUND ' S20201 26180020 DC C'18W INVALID ERROR ' S20201 26190020 DC C'19W WRONG ERROR ' S20201 26200020 DC C'20W CHAN. CTRL ERROR' S20201 26210020 DC C'21W INTERFACE ERROR ' S20201 26220020 DC C'22W CHAN. DATA CHECK' S20201 26230020 DC C'23W DASD OVERFLOW ' S20201 26240020 DC C'24W PROGRAM CHECK ' S20201 26250020 DC C'25W PROTECTION CHECK' S20201 26260020 DC C'26W UNIT EXCEPTION ' S20201 26270020 DC C'27W INCORRECT LENGTH' S20201 26280020 DC C'28W CHAINING CHECK ' S20201 26290020 DC C'29W COMMAND SEQ. ERR' S20201 26300020 DC C'30W SEEK CHECK ERROR' S20201 26310020 DC C'31W WRITE DATA CHECK' S20201 26320020 DC C'32W TAPE--LOAD POINT' S20201 26330020 DC C'34W MISSING ADR-MARK' S20201 26340020 DC C'43W WRITE INHIBITED ' WRITE INHIBITED M4698 26345020 EJECT 26350020 * REGISTER ASSIGNMENT 26360020 SPACE 2 26370020 RWRKREG3 EQU 0 26380020 SPACE 1 26390020 RUCBPTR EQU 2 26400020 SPACE 1 26410020 RWRKREG8 EQU RUCBPTR 26420020 SPACE 1 26430020 RCAW EQU 3 26440020 SPACE 1 26450020 RWRKREG7 EQU RCAW 26460020 SPACE 1 26470020 RTRKADR1 EQU 4 26480020 SPACE 1 26490020 RLINK2 EQU 5 26500020 SPACE 1 26510020 RWRKREG1 EQU 6 26520020 SPACE 1 26530020 RWRKREG4 EQU 7 26540020 SPACE 1 26550020 RWRKREG5 EQU 8 26560020 SPACE 1 26570020 RLINK1 EQU 9 26580020 SPACE 1 26590020 RWRKREG6 EQU RLINK1 26600020 SPACE 1 26610020 REIGHT EQU 10 26620020 SPACE 1 26630020 RSTOPLST EQU 11 26640020 SPACE 1 26650020 RWTRDCCW EQU 1 26660020 SPACE 1 26670020 RBASE2 EQU 13 26680020 SPACE 1 26690020 RWRKREG2 EQU 14 26700020 SPACE 1 26710020 RBEGTRK EQU 15 26720020 SPACE 1 26730020 RTRKADR EQU RBEGTRK 26740020 EJECT 26750020 SPACE 1 26760020 SPACE 2 26770020 ORG0500X EQU * 5274 26780020 ORG ENTER+8192 5274 26790020 ORG0600 EQU * 5274 26800020 * **************** 26810020 * * HOUSEKEEPING * 26820020 * **************** 26830020 SPACE 1 26840020 * 1) MOVE THE PROPER "CONTROL BLOCKS" TO THE "TO" 26850020 * AND "FROM" CONTROL AREAS. 26860020 SPACE 1 26870020 * 2) SET UP ADDRESS OF THE PROPER WRITE ROUTINE. 26880020 * (RLINK2 ROUTINE) 26890020 SPACE 1 26900020 START1A L RBASE2,BUFRBAS ESTABLISH BUFFER BASE REGISTER 26910020 SR RWRKREG1,RWRKREG1 26920020 IC RWRKREG1,UCBFRM GET CODE FOR DEVICE FROM AND 26930020 SLL RWRKREG1,4 MODIFY FOR INDEXING TO MOVE 26940020 LA RWRKREG1,DEVCTRL(RWRKREG1) DATA CONCERNING DEVICE TO 26950020 MVC FRMDCTRL(16),0(RWRKREG1) DEVICE CONTROL AREA 26960020 SPACE 1 26970020 SR RWRKREG1,RWRKREG1 26980020 IC RWRKREG1,UCBTO GET CODE FOR DEVICE TO AND 26990020 SLL RWRKREG1,4 MODIFY FOR INDEXING TO MOVE 27000020 LA RWRKREG1,DEVCTRL(RWRKREG1) DATA CONCERNING DEVICE TO 27010020 MVC TODCTRL(16),0(RWRKREG1) DEVICE CONTROL AREA 27020020 BR RLINK1 RETURN TO CTL CHECK 27030020 SPACE 2 27040020 START1 L RBASE2,BUFRBAS ESTABLISH BUFFER BASE REGISTER 27050020 CLI UCBTO,X'00' IS DEVICE A 2321 S20201 27060020 BE BINOK YES, BIN IS OK S20201 27070020 CLI UCBFRM,X'00' IS FROM DEVICE A 2321 S20201 27080020 BE BINOK YES, BIN IS OK S20201 27090020 XC BBCCHH(2),BBCCHH CLEAR BIN NO IN SEEK S20201 27100020 BINOK EQU * CONNECTOR S20201 27110020 MVI TAPESW,X'00' SET TAPE SWITCH TO ZERO 27120020 L RBEGTRK,ENDADR PREPARE TO BUMP ENDADR 27130020 ST RBEGTRK,CCHH SET FOR CYL CHANGE ROUTINE 27140020 BAL RLINK1,CHANGCYL INCRIMENT TRACK ADDRESS 27150020 SPACE 1 27160020 BEG1 ST RBEGTRK,ENDADR 27170020 L RBEGTRK,BGNADR GET BEGINNING ADDRESS 27180020 CLI UCBFRM,X'05' DUMP OF 2301 DRUM. 27190020 BC 7,NOTDRUM NO--READ COUNT M/T CCW IS OKAY. 27200020 L GR5,DUMMYCCW YES-PICK UP CCW ADDRESS. 27210020 A GR5,CON32K ADD 32K TO CCW ADDRESS. 27220020 ST GR5,DUMMYCCW RESTORE THE MODIFIED CCW. 27230020 EJECT 27240020 * ************************** 27250020 * * HOUSEKEEPING CONTINUED * 27260020 * ************************** 27270020 * * RLINK2 CODE * 27280020 * *************** 27290020 SPACE 2 27300020 * "DASD CONTROL" IS USED TO LOAD THE ADDRESS OF THE 27310020 * BEGINNING OF THE ROUTINES INTO "RLINK2" REGISTER. 27320020 * (HENCE, THE NAME "RLINK2") 27330020 SPACE 1 27340020 * IN CASE OF DUMP, THE CKD FIELDS ARE READ INTO THE 27350020 * BUFFER THEN THE PROPER "RLINK2" LOOP ROUTINE IS USED TO 27360020 * WRITE THE DATA (PACKED CKD FIELDS) AND CONTROL 27370020 * INFORMATION ONTO THE TRANSIENT DEVICE 27380020 SPACE 1 27390020 * PRIOR TO ENTERING "MAIN" RLINK2 ROUTINE, 27400020 * PRELIMINARY CHECKING IS DONE. 27410020 SPACE 2 27420020 NOTDRUM LA RLINK2,TOFM2311 2311 TO 2311, 2314 TO 2314 27430020 CLC UCBFRM(1),UCBTO IS IT ABOVE 27440020 BNE CHKDMP NO,CHECK IF DUMP M5581 27446020 TM SEQSW,X'04' IS THIS A DUMP REQUEST M5581 27452020 BZ MOUNTAPE NO,TERMINATE WITH ERROR M5581 27458020 B HAVEADDR YES, PROCEED M5581 27464020 CHKDMP TM SEQSW,X'04' IS THIS A DUMP REQUEST M5581 27470020 BZ SETRESTR NO 27480020 SPACE 1 27490020 L RLINK2,XSTARTD INDEX FOR PRE RLINK2 ADDRESS 27500020 L RLINK2,XSTARTD1(RLINK2) SET PRE RLINK2 ADDRESS 27510020 B HAVEADDR AND GO 27520020 SPACE 1 27530020 SETRESTR L RLINK2,XSTARTR INDEX FOR PRE RLINK2 ADDRESS 27540020 L RLINK2,XSTARTR1(RLINK2) SET PRE RLINK2 ADDRESS 27550020 HAVEADDR LM RWRKREG4,RWRKREG5,BGNADR GET BEGINNING AND END+1 ADDRESS 27560020 STM RWRKREG4,RWRKREG5,DTABUFF PREPARE TO WRITE IT 27570020 ST RTRKADR,DTABUFF+8 SAVE RELATIVE BEGINNING ADDRESS 27580020 MVC DTABUFF+12(8),PRTKCODE SET CODE TO PROTECT READING 27590020 * FROM SCRATCH TAPE IN RESTORE 27600020 MVC DTABUFF+20(1),FULLDPSW SAVE "FULL DUMP" SWITCH 27610020 MVC DTABUFF+21(1),UCBFRM TELL DEVICE TYPE 27620020 BR RLINK2 GO TO PROPER "RLINK2" PRELIMIN- 27630020 * ARY SUBROUTINE 27640020 EJECT 27650020 * *************************** 27660020 * * HOUSEKEEPING CONTINUED * 27670020 * *************************** 27680020 * * PRELIMINARY RLINK2 * 27690020 * ********************** 27700020 * * DUMP * 27710020 * ******** 27720020 SPACE 2 27730020 * ROUTINES USED TO PERFORM THE FOLLOWING. 27740020 SPACE 1 27750020 * 1) BE SURE AT LOAD POINT IF TAPE INVOLVED 27760020 * IN DUMP 27770020 SPACE 1 27780020 * 2) BEGINNING, END, AND RELATIVE BEGINNING 27790020 * ADDRESSES OF DASD ARE WRITTEN ON TRANSIENT DEVICE. 27800020 SPACE 2 27810020 TOTAPE MVI WRTTPDTA+7,X'18' HEADER REC LENGTH = 24 A53319 27820021 XC 80(4),80 CLEAR THE TIMER. 27830020 MVI TAPESW,X'01' SET TAPE SWITCH ON 27840020 LA RUCBPTR,UCBTO GET POINTER TO UNIT CONTROL 27850020 LA RCAW,XREWCCW BE SURE TAPE IS AT LOAD POINT 27860020 BAL RLINK1,STARTIO 27870020 SPACE 1 27880020 LA RWRKREG4,VTAPESET RETURN FROM ROUTINE 27890020 SETMODET LA GR3,SENSETAP SENSE COMMAND ADDRESS 27900020 BAL RLINK1,STARTIO START I/O 3479 27910020 CLI MODESW,X'0F' HAS USER DETERMINED MODE 27920020 BE SETUSRMD YES- ESTABLISH HIS MODE 27930020 LA GR3,MODE4793 LOAD WITH '93' FOR 7 TRACK 27940020 SET7 MVC XRDVOLID(1),0(GR3) SET MODE FOR 7 TRACK TAPE 3479 27950020 XI XRDVOLID,X'10' SET MODE FOR EVEN 3479 27960020 OI XRDVOLID,X'28' PARITY,TRANSLATE ON 3479 27970020 TM TAPEBUFS+1,X'10' TEST IF 7 TRACK TAPE 3479 27980020 BC 1,SET47 MODE SET FOR 7 TRACK 27990020 LA GR3,MODE49C3 LOAD WITH 'C3' FOR 9 TRACK 1600 28000020 SET9 MVC XRDVOLID(1),0(GR3) SET MODE FOR 9 TRACK TAPE 3479 28010020 SET47 MVC SETMODE1(1),0(GR3) SET MODE 7 OR 9 TRACK 800/1600 28020020 MVC SETMODE2(1),0(GR3) SET MODE 7 OR 9 TRACK 800/1600 28030020 MVC SETMODE3(1),0(GR3) SET MODE 7 OR 9 TRACK 800/1600 28040020 MVC SETMODE4(1),0(GR3) SET MODE 7 OR 9 TRACK 800/1600 28050020 MVC SETMODE5(1),0(GR3) SET MODE 7 OR 9 TRACK 800/1600 28060020 MVC XRDTRLR(1),0(GR3) SETMODE 7 OR 9 TRACK 3479 28070020 MVC WTMCCW(1),0(GR3) 2324 28080020 BR RWRKREG4 RETURN TO VTAPESET OR FRMTAPEA 28090020 SETUSRMD LA GR3,MODESET+1 USER MODE 28100020 TM TAPEBUFS+1,X'10' TEST IF 7 TRACK 3479 28110020 BC 1,SET7 YES, SET MODE FOR 7 TRACK 3479 28120020 BC 15,SET9 NO, SET MODE FOR 9 TRACK 3479 28130020 VTAPESET MVI CKVOLSW,X'21' SET DUMP EOF AND A27583 28140020 * INITIAL LABEL SWITCH A27583 28150020 BALR RWRKREG4,0 RETURN IF DATA CHECK A27583 28160020 LA RCAW,XRDVOLID GET INITIAL TAPE LABEL 28170020 BAL RLINK1,STARTIO 28180020 CLC SAVEVTOC+49(20),DASDIDR IS THIS LOADER CARD FOR DASDI 28190020 BE RDLABELS YES, TAPE MARK WILL FOLLOW 28200020 SPACE 1 28210020 CLC VOL1(3),SAVEVTOC IS THIS RECORD A LABEL 28220020 BNE TOTAPE1A NO 28230020 SPACE 1 28240020 LA RSTOPLST,VOLLABEL+36 GET VOLUME LABEL 28250020 LA RWTRDCCW,VOLLABEL TABLE 28260020 CKLABEL CLC SAVEVTOC+4(6),0(RWTRDCCW) DOES LABEL ON DISK AGREE 28270020 * WITH LABEL IN TABLE 28280020 BE RDLABELS YES 28290020 LA RWTRDCCW,6(RWTRDCCW) NO, GET NEXT LABEL FROM 28300020 CLR RWTRDCCW,RSTOPLST LABEL A23097 28310020 BNH CKLABEL TABLE 28320020 B PRNTMESS LABEL ISN'T IN LABEL TABLE 28330020 SPACE 1 28340020 RDLABELS MVI CKVOLSW,X'41' STANDARD LBL SCRATCH OR LDR 2324 28350020 BAL RLINK1,STARTIO LOOP THROUGH TO BYPASS REST 2324 28360020 B RDLABELS OF LABELS 28370020 SPACE 1 28380020 TOTAPE1A LA RCAW,XREWCCW REWIND TAPE 28390020 BAL RLINK1,STARTIO AGAIN 28400020 LA RCAW,WTMCCW WRITE A TAPE MARK FOR 28410020 BAL RLINK1,STARTIO CONSISTANCY 28420020 SPACE 1 28430020 TOTAPE1B MVI CKVOLSW,X'00' TURN OFF EOF SWITCH 28440020 MVI SAVEVTOC,X'00' CLEAR 28450020 MVC SAVEVTOC+1(96),SAVEVTOC VTOC AREA 28460020 B BULDCCW1 GO WRITE HEADER RECORD 28470020 SPACE 1 28480020 TO2314 MVC TOTLTRK(12),TOTLTRK1 RESET CONSTANTS FOR 2314. 28490020 B TO2311 CHECK VOLUME LABEL S20201 28500020 TO3330 MVC TOTLTRK(ONETWO),TOTLTRK2 SET CONSTANTS FOR 3330 S20201 28510020 TO2311 BAL RLINK2,CKVOLLBL GO CHECK VOLUME LABEL 28520020 SPACE 1 28530020 MVC WTRDDATA(8),LIMITCCW 28540020 LA RTRKADR1,1 SET UP FOR TRACK1; CYLINDER 0 28550020 ST RTRKADR1,CCHH GET TRACK ADDRESS 28560020 LA RLINK2,DMP2302 CHANGE RLINK2 TO LOOP ADDRESS 28570020 LA RTRKADR1,1(RTRKADR1) BUMP TRACK ADDRESS 28580020 MVI NON2311,X'01' TURN ON UNLIKE DASD SWITCH 28590020 B WRTDISK WRITE BEGINNING AND END ADDRESS 28600020 SPACE 1 28610020 TOFM2311 BAL RLINK2,CKVOLLBL GO CHECK VOLUME LABEL 28620020 SPACE 1 28630020 MVC ADDRSCH1+9(3),A1 CHANGE TIC ADDRESS IN HAR0CCWS 28640020 MVC ADDRSCH2+9(3),A2 CHANGE TIC ADDRESS IN HAR0CCWS 28650020 LA RLINK2,WRTDISK CHANGE RLINK2 TO LOOP ADDRESS 28660020 B BUILDCCW START LOOP 28670020 SPACE 2 28680020 EJECT 28690020 * *************************** 28700020 * * HOUSEKEEPING CONTINUED * 28710020 * *************************** 28720020 * PRELIMINARY RLINK2 * 28730020 * ********************** 28740020 * * RESTORE * 28750020 * *********** 28760020 SPACE 2 28770020 * ROUTINES USED TO PERFORM THE FOLLOWING 28780020 SPACE 1 28790020 * 1) CHECK THE VOLUME LABEL OF THE DEVICE "RESTORING" 28800020 * TO, TO BE SURE IT IS THE ONE ASKED FOR. 28810020 SPACE 1 28820020 * 2) GET THE BEGINNING, END, AND RELATIVE BEGINNING ADDRESSES. 28830020 SPACE 2 28840020 FRMTAPE BAL RLINK2,CKVOLLBL GO CHECK VOLUME LABEL 28850020 SPACE 1 28860020 FRMTAPE1 LA RLINK2,RSTRTAPE GET NORMAL LOOP ADDRESS 28870020 XC 80(4),80 CLEAR THE TIMER. 28880020 LA RUCBPTR,UCBFRM GET POINTER TO UNIT CONTROL 28890020 LA RCAW,XREWCCW BE SURE TAPE IS AT LOAD POINT 28900020 BAL RLINK1,STARTIO 28910020 SPACE 1 28920020 FRMTAPEA LA RUCBPTR,UCBFRM GET POINTER TO CONTROL UNIT 28930020 BAL RWRKREG4,SETMODET SET TAPE MODE 28940020 MVI CKVOLSW,X'22' SET RESTORE EOF AND A27583 28950020 * INITIAL LABEL SWITCH A27583 28960020 BALR RWRKREG4,0 RETURN IF DATA CHECK A27583 28970020 LA RCAW,XRDVOLID READ LABEL OR LOADER A27583 28980020 LABTAPE BAL RLINK1,STARTIO 28990020 MVI CKVOLSW,X'02' EOF SWITCH ONLY A27583 29000020 SPACE 1 29010020 B LABTAPE LOOP THROUGH TO BYPASS LABELS 29020020 SPACE 1 29030020 RTRNTM MVI CKVOLSW,X'00' TURN OFF EOF SWITCH 29040020 LA RCAW,RDTPDTA-8 CCW FOR HEADER RECORD 3479 29050020 MVC RDTPDTA+2(2),SETMODE4+2 RESET ADDRESS 3479 29060020 BAL RLINK1,STARTIO READ BEGINNING AND END ADDRESS 29070020 SPACE 1 29080020 MVI RDTPDTA+6,X'FF' RESTORE (MAX) READ COUNT 29090020 SPACE 1 29100020 CLC DTABUFF+12(8),PRTKCOD1 RESTORE TAPE OF LEVEL3(2311). 29110020 BE TAPEOK YES DO NOT CHECK DEVICE CODE. 29120020 CLC DTABUFF+12(8),PRTKCODE IS THIS A RESTORE TAPE. 29130020 BNE WRNGTAPE NO--GO GIVE MESSAGE AND WAIT. 29140020 CLC DTABUFF+21(1),UCBTO RESTORE TYPE SAME AS DUMP TYPE. 29150020 BNE WNGDEV NO--GO GIVE ERROR MESSAGE. 29160020 TAPEOK MVC BGNADR(8),DTABUFF STORE BEGIN AND END ADDRESSES. 29170020 L RTRKADR,DTABUFF+8 GET RELATIVE BEGINNING ADDRESS 29180020 MVC FULLDPSW(1),DTABUFF+20 RECOVER SW TO TELL IF FULL RSTR 29190020 CLI UCBTO,X'05' IS THIS A 2301 DRUM RESTORE. 29200020 BE ONLY32K YES-DOESN'T PAY TO BUFFER. 29210020 CLI UCBTO+2,X'00' IS TO DEVICE ON MULTIPLEXOR 5981 29220020 BE ONLY32K YES-DO NOT BUFFER. 5981 29230020 CLI UCBFRM+2,X'00' IS FROM DEVICE ON MULTIPLEX 5981 29240020 BE ONLY32K YES-DO NOT BUFFER. 5981 29250020 L GR3,CON64KK PICK UP 64K CONSTANT. 29260020 MVC 108(4),ONLY32KA SET UP NEW PROGRAM PSW. 29270020 ST GR3,0(GR3,0) TEST FOR PROGRAM INTERRUPT. 29280020 MVI SW64K,X'FF' NO INTERRUPT//AT LEAST 64K. 29290020 LM GR2,GR3,DTALENG1 NEW ADDRESS FOR TAPE CCWS. 29300020 ST GR2,RDTPCCW MODIFY FOR CCW LIST READ IN. 29310020 ST GR3,RDTPDTA MODIFY FOR DATA READ IN. 29320020 ONLY32K MVC 108(4),REGPSW RESET NEW PROGRAM PSW. 29330020 BR RLINK2 BRANCH TO PROPER ROUTINE. 29340020 SPACE 1 29350020 WRNGTAPE LA RLINK1,FRMTAPEA PREPARE 29360020 LA RCAW,XREWCCW TO PRINT 29370020 WRNGTAP1 STM 0,15,ERRSAV1 MESSAGE 29380020 B MOUNTAPE GO TO PRINT MOUNT TAPE MESSAGE. 29390020 WNGDEV LA ERREG1,58 29400020 MVC PRWD(58),MESS3 29410020 BAL LINK9,PRNT 29420020 B WAITZ 29430020 SPACE 2 29440020 FRM2314 MVC TOTLTRK(12),TOTLTRK1 SET FOR 2314. 29450020 B FRM2311 CHECK VOLUME LABEL S20201 29460020 FR3330 MVC TOTLTRK(ONETWO),TOTLTRK2 SET CONSTANTS FOR 3330 S20201 29470020 FRM2311 BAL RLINK2,CKVOLLBL GO CHECK VOLUME LABEL 29480020 SPACE 1 29490020 FRM2311A MVC WTRDDATA+8(8),LMITCCW1 PREPARE TO READ 29500020 LA RTRKADR1,1 SET UP FOR TRACK1, CYLINDER 0 29510020 ST RTRKADR1,CCHH BEGINNING AND END TRACK ADR 29520020 LA RLINK2,RSTR2302 GET NORMAL LOOP ADDRESS 29530020 LA RTRKADR1,1(RTRKADR1) BUMP TRACK ADDRESS 29540020 LA RUCBPTR,UCBFRM GET POINTER TO UNIT CONTROL 29550020 LA RCAW,SEEKCCW GET CCW ADDRESS 29560020 MVI TAPESW,X'02' SET SWITCH TO TELL ALT1 IS RSTR 29570020 BAL RLINK1,STARTIO 29580020 SPACE 1 29590020 CLC DTABUFF+12(8),PRTKCOD1 RESTORE TAPE OF LEVEL3(2311). 29600020 BE PACKOK YES--DO NOT CHECK DEVICE CODE. 29610020 CLC DTABUFF+12(8),PRTKCODE THIS A RESTORE TAPE. 29620020 BNE WRNGTAP1 NO--GIVE MESSAGE//TERMINATE. 29630020 CLC DTABUFF+21(1),UCBTO RESTORE TYPE SAME AS DUMP TYPE. 29640020 BNE WNGDEV NO--GIVE MESSAGE//TERMINATE. 29650020 PACKOK MVC FULLDPSW(1),DTABUFF+20 FULL RESTORE SWITCH. 29660020 L RTRKADR,DTABUFF+8 GET RELATIVE BEGINNING ADDRESS 29670020 MVC BGNADR(8),DTABUFF GET BEGINNING AND END ADDRESS 29680020 BR RLINK2 START LOOP 29690020 EJECT 29700020 * ********************** 29710020 * * CHECK VOLUME LABEL * 29720020 * ********************** 29730020 SPACE 1 29740020 * 1) CHECKS VOLUME LABEL ON ALL TODEVICES 29750020 * EXCEPT TAPE 29760020 SPACE 2 29770020 CKVOLLBL MVI NORCDSW,X'F0' TURN ON NO RECORD FOUND SWITCH 29780020 LA RUCBPTR,UCBTO PREPARE TO READ 29790020 XC CCHHR(4),CCHHR 29800020 MVI CCHHR+4,X'03' 29810020 MVC CCHH(5),CCHHR VOLUME ID 29820020 RETRY LA RCAW,SEARCHID CCW LIST FOR VOLUME LABEL. 29830020 MVI UCBTO+24,X'00' CLEAR FIRST SENSE BYTE. 29840020 BAL RLINK1,STARTIO GET VOLUME LABEL 29850020 TM UCBTO+24,X'02' IS VOLUME LABEL ON ALTERNATE. 29860020 BC 1,YESALT YES--SET UP FOR ALTERNATE. 29870020 MVI NORCDSW,X'00' RESET NO RECORD SWITCH 29880020 CLC SAVEVTOC(4),VOLABID IS THIS A SYSTEM VOLUME LABEL. 29890020 BC 8,VOLYES YES-COMPARE THE SERIAL NUMBERS. 29900020 SPACE 1 29910020 MVI NORCDSW,X'0A' NO--SET UP TO PRINT INVALID MSG. 29920020 B PRNTMESS PRINT MESSAGE ABOUT VOLI/D. 29930020 YESALT LA RCAW,SEEKALT READ HA / R0 OF BAD TRACK. 29940020 BAL RLINK1,STARTIO PERFORM THE IO. 29950020 MVC CCHH(4),ALTBUFF+5 CCHH OF ALTERNATE. 29960020 MVC CCHHZERO(4),ALTBUFF+5 SAVE THIS ALTERNATE TRACK. 29970020 B RETRY READ LABEL FROM ALTERNATE. 29980020 SPACE 1 29990020 VOLYES LA RSTOPLST,VOLLABEL+36 SET UP FOR 30000020 LA RWTRDCCW,VOLLABEL MULTIPLE LABELS (CNTRL ST) 30010020 RECHKLAB CLC 0(6,RWTRDCCW),USEDLABL HAS THE LABEL BEEN USED 30020020 BE NEWLABEL YES, GET ANOTHER ONE 30030020 CLC SAVEVTOC+4(6),0(RWTRDCCW) DO LABELS AGREE 30040020 BE LABLAGRE YES, GO ON 30050020 SPACE 1 30060020 NEWLABEL LA RWTRDCCW,6(RWTRDCCW) GET READY TO TRY AGAIN 30070020 CLR RWTRDCCW,RSTOPLST USED ALL CNTRL ST LABELS 30080020 BNH RECHKLAB NO, TRY AGAIN 30090020 B PRNTMESS YES,LABEL NOT AGREE WITH CNTRL ST 30100020 SPACE 1 30110020 LABLAGRE MVC 0(6,RWTRDCCW),USEDLABL UPDATE CONTROL LABEL ADDRESS 30120020 MVC CCHHR(5),SAVEVTOC+11 SET UP SEARCH ADDRESS. 30130020 MVC CCHH(4),SAVEVTOC+11 SET UP SEEK ADDRESS. 30140020 BAL RLINK1,STARTIO 30150020 MVC ALTDATA(6),SAVEVTOC+8 SAVE ALT TRK INFORMATION 30160020 MVI R,X'00' SET R OF CCHHR TO ZERO. 30170020 BR RLINK2 RETURN 30180020 SPACE 1 30190020 RCDRTN MVI NORCDSW,X'0A' SET NO RECORD SWITCH TO INVALID. 30200020 PRNTMESS MVC PRWD(89),MESS7 TELL OPERATOR VOLUME LABEL 30210020 LA CSR1,89 DOESN'T AGREE WITH ONE MOUNTED. 30220020 BAL RLINK1,PRNT AGREE 30230020 TM NORCDSW,X'0A' IS VOL I/D INVALID FORMAT. 30240020 BC 14,SERPRINT NO--PRINT SERIAL ERROR MSG. 30250020 MVC PRWD+9(16),INVALID TELL VOLID COULD NOT BE FOUND. 30260020 B VPRINT1 GO PRINT THE MESSAGE. 30270020 SPACE 1 30280020 SERPRINT MVC PRWD+15(6),SAVEVTOC+4 LABEL I/D. 30290020 VPRINT MVC PRWD+9(6),VOLIDIS PRINT VOLUME 30300020 VPRINT1 LA CSR1,26 LENGTH OF MESSAGE. 30310020 SPACE 1 30320020 LA RLINK1,WAITZ AND PREPARE TO GO IS SOLID WAIT 30330020 B PRNT 30340020 INVALID DC C'VOLID IS INVALID' 30350020 VOLABID DC C'VOL1' 1ST FOUR BYTES OF R-3 DATA FLD. 30360020 EJECT 30370020 * **************************************** 30380020 * * SUBROUTINE USED TO MOVE DATA OR CCWS * 30390020 * **************************************** 30400020 SPACE 2 30410020 SETUP LA RWRKREG7,255 SET NO BYTES FOR EX OPCDOE 30420020 MOVEAGN CL RWRKREG4,TWO56 WILL THIS BE THE LAST MOVE. 30430020 BNH LASTTIME YES--IT IS THE LAST MOVE. 30440020 EX RWRKREG7,MOVECHAR MOVE 256 CHARACTERS. 30450020 LA RWRKREG5,256(RWRKREG5) INCREMENT MOVE FROM ADDRESS. 30460020 LA RWRKREG6,256(RWRKREG6) INCREMENT MOVE TO ADDRESS. 30470020 S RWRKREG4,TWO56 DECREMENT TOTAL COUNT. 30480020 B MOVEAGN RETURN TO CHECKPOINT. 30490020 SPACE 30500020 LASTTIME LR RWRKREG7,RWRKREG4 GET REMAINING NO OF BYTES. 30510020 BCTR RWRKREG7,0 DECREMENT FOR MVC. 30520020 EX RWRKREG7,MOVECHAR MOVE THE CHARACTERS. 30530020 BR REG1 RETURN 30540020 EJECT 30550020 * ************************ 30560020 * * BUILD READ COUNT CCW * 30570020 * ************************ 30580020 SPACE 1 30590020 * 1) BUILD A LIST OF READ COUNT CCWS OF LENGTH 30600020 * NECESSARY TO READ THE MAXIMUM NUMBER OF 30610020 * RECORDS FOR THIS DEVICE. 30620020 SPACE 2 30630020 BULDCCW1 LA RLINK2,NONOISE2 30640020 BUILDCCW LM RWRKREG4,RWRKREG5,DUMMYCCW GET FILL CCW 30650020 LA REIGHT,8 LOAD INCREMENTING FACTOR. 30660020 LA RWTRDCCW,WTRDCCW SET UP BEGINNING ADDRESS 30670020 LR RSTOPLST,RWTRDCCW SET UP ENDING ADDRESS 30680020 AH RSTOPLST,MNCCWX8F FOR STOPING FACTOR 30690020 MVI R,X'00' SET R OF CCHHR TO ZERO. 30700020 SPACE 2 30710020 CREATCCW STM RWRKREG4,RWRKREG5,0(RWTRDCCW) STORE DUMMY CCW IN LIST 30720020 AR RWRKREG4,REIGHT UPDATE ADDRESS OF NXT CCW 30730020 SPACE 2 30740020 BXLE RWTRDCCW,REIGHT,CREATCCW UPDATE CCW LIST ADDRESS 30750020 * AND LOOP THROUGH IF NOT 30760020 * DONE 30770020 MVC WTRDDATA(8),DATAR0 SET R/W DATA TO READ 30780020 L BASE10,SYSBAS RESTORE BASE REGISTER 30790020 EJECT 30800020 * *************** 30810020 * * READ COUNTS * 30820020 * *************** 30830020 SPACE 1 30840020 * 1) SET UP TRACK ADDRESS AND OTHER INFORMATION 30850020 * TO READ "COUNT" FIELDS FROM THE PROPER TRACK. 30860020 SPACE 1 30870020 MODTKADA TM TAPESW,X'01' IS THIS DUMP TO TAPE. 30880020 BC 1,MODTKADF YES,GO TO READ COUNTS 30890020 TM R0SWITCH,X'01' IS THIS HA R0 ONLY 30900020 BC 8,MODTKADF NO,GO TO READ COUNTS. 30910020 L RLINK2,SAVELK2 YES,RESTORE THE LINK REGISTER. 30920020 LA RCAW,HAR0CCW POINT TO HA R0 CCW LIST. 30930020 LA RUCBPTR,UCBTO PREPARE TO EXECUTE CCWS. 30940020 BAL RLINK1,STARTIO WRITE HA-R0 ONLY RECORD. 30950020 MASK1 CLI UCBTO+1,X'00' IS DIRECT ACCESS FINISHED 30960020 BC 7,MASK1 NO - AWAIT COMPLETION 30970020 MVI R0SWITCH,X'00' TURN OFF HA-R0 ONLY SWITCH. 30980020 SPACE 1 30990020 MODTKADF ST RTRKADR,CCHH STORE TRACK ADDRESS 31000020 CL RTRKADR,ENDADR FINISHED 31010020 BE EOJ100 YES-GO WRITE DATA. 31020020 SPACE 1 31030020 LA RUCBPTR,UCBFRM PREPARE TO READ 31040020 LA RCAW,SEEKCCW COUNT 31050020 SPACE 1 31060020 BAL RLINK1,CHANGCYL INCRIMENT TRACK ADDRESS 31070020 BAL RLINK1,STARTIO1 READ COUNT FIELDS. 31080020 MASK2 CLI UCBFRM+1,X'00' IS DIRECT ACCESS FINISHED 31090020 BC 7,MASK2 NO - AWAIT COMPLETION 31100020 TAPETEST TM TAPESW,X'01' IS THIS DUMP TO TAPE 31110020 BCR 1,RLINK2 YES--GO WRITE RECORD ON TAPE 31120020 B NONOISE1 NO--WAIT FOR DIRECT ACCESS 31130020 EOJ100 MVI EOJSW,X'FF' SET SWITCH FOR END OF JOB. 31140020 B TAPETEST 31150020 NONOISE2 LA RCAW,WRTTPDTA-8 CCW LIST. 31160020 LA RUCBPTR,UCBTO TO DEVICE. 31170020 CLC WRTTPDTA+6(2),NOISECK IS THIS A NOISE RECORD. 31180020 BNL NONOISE NO-- 31190020 MVI WRTTPDTA+7,X'18' YES-INCREASE COUNT. 31200020 NONOISE BAL RLINK1,STARTIO1 WRITE TAPE RECORD(HDR OR DATA). 31210020 SPACE 1 31220020 NONOISE1 CLI UCBFRM+1,X'00' IS DIRECT ACCESS FINISHED. 31230020 BC 7,NONOISE1 NO--AWAIT COMPLETION. 31240020 MVC SEEKCCW(4),HAR0CCW RESET SEEK ADDRESS. 31250020 TAPECOMP CLI UCBTO+1,X'00' IS TAPE COMPLETE. 31260020 BC 7,TAPECOMP NO--AWAIT COMPLETION. 31270020 TM EORSW,X'FF' FF MEANS END OF REEL 5274 31280020 MVI EORSW,X'00' RESET SWITCH 5274 31290020 BO RESET15 DECREMENT GR15 ONE TRACK 5274 31300020 CLI EOJSW,X'FF' IS THE JOB FINISHED. 31310020 BE EOJ1 GO GIVE EOJ MESSAGE. 31320020 MVC DTABUFF(8),R0DATA 31330020 EJECT 31340020 * ******************* 31350020 * * BUILD READ CCWS * 31360020 * ******************* 31370020 SPACE 1 31380020 * 1) BE SURE PREVIOUS READ COUNT WAS GOOD 31390020 SPACE 1 31400020 * 2) GET ADDRESS OF LAST CCW "ACTUALLY" USED. 31410020 SPACE 1 31420020 * 3) CHANGE CCW LIST TO READ COUNT KEY AND DATA. 31430020 SPACE 1 31440020 * 4) FILL PROPER ADDRESS IN EACH CCW. 31450020 SPACE 1 31460020 * 5) FILL PROPER COUNT FIELD IN EACH CCW. 31470020 SPACE 1 31480020 * 6) ACCUMULATE TOTAL NUMBER OF BYTES OF DATA. 31490020 SPACE 31500020 * 7) TURN OFF CHAIN COMMAND FLAG OF DISK CCW LIST. 31510020 SPACE 31520020 ANALSENS TM UCBFRM+25,X'04' 31530020 BZ CKALT NO, CHECK 31540020 SPACE 2 31550020 CNGRDCKD LM RWRKREG4,RWRKREG5,DMMYRCCW GET DUMMY READ CCWS 31560020 L RSTOPLST,UCBFRM+16 LOAD ADDR OF LAST RCNT CCW 31570020 LA REIGHT,8 SET UP REGISTER. 31580020 N RSTOPLST,MASKOPCD EXICUTED AND MASK OFF CCODE 31590020 S RSTOPLST,SIXTEENX MODIFY TO POINT TO LAST EXICUTD 31600020 LA RWTRDCCW,WTRDCCW GET ADDR OF FIRST READ CCW 31610020 L RWRKREG1,ADCTBUFF BUFFER ADDRESS FOR COUNT FIELDS 31620020 CLI UCBFRM,X'05' THIS A 2301 DRUM. 31630020 BC 7,CTBUFFOK NO-COUNT BUFFER ADDRESS IS OKAY 31640020 A RWRKREG1,CON32K YES-BUFFER AT HIGH END OF 64K. 31650020 CTBUFFOK LR RWRKREG2,REIGHT SET TO ACCUMULATE COUNTS. 31660020 CLR RSTOPLST,RWTRDCCW ANY RECORDS BESIDES R0 31670020 BNL NEWRDCKD YES--CONTINUE 31680020 TM NON2311,X'01' IS UNLIKE DASD SWITCH ON 31690020 BC 8,STORLINK NO,CONTINUE 31700020 MVC SEEKCCW(72),HAR0CCW SET UP HA R0 ONLY CCWS 31710020 LA RWRKREG1,88 SET UP COUNT FIELDS 31720020 B GOWRITE GO TO WRITE CCWS. 31730020 SPACE 31740020 STORLINK ST RLINK2,SAVELK2 SAVE LINK REGISTER 31750020 MVI R0SWITCH,X'01' INDICATE HA-R0 ONLY. 31760020 MVC SEEKCCW(4),HAR0CCW RESET SEEK ADDRESS 31770020 BAL RLINK2,MODTKADA NO--READ COUNTS NEXT TRACK. 31780020 SPACE 31790020 HAR0 MVI R0SWITCH,X'00' TURN OFF HA-R0 ONLY SWITCH. 31800020 L RLINK2,SAVELK2 RESTORE LINK REGISTER 31810020 LA UCBREG,UCBTO TAPE UCB. 31820020 LA RCAW,SETMODE5 CCWS FOR SPECIAL LIST. 31830020 BAL RLINK1,STARTIO WRITE SPECIAL CCWS ON TAPE. 5434 31840020 LA RCAW,24 LENGTH OF DATA RECORD. 5434 31850020 STH RCAW,WRTTPDTA+6 SET COUNT IN CCW. 5434 31860020 LA RCAW,SETMODE2 TAPE CCW ADDRESS. 5434 31870020 BAL RLINK1,STARTIO WRITE R0 DATA RECORD ON TAPE 31880020 B NONOISE1 GO WAIT ON DIRECT ACCESS. 31890020 SPACE 2 31900020 NEWRDCKD IC RWRKREG5,5(RWRKREG1) GET THE KEY LENGTH. 31910020 AH RWRKREG5,6(RWRKREG1) ADD THE DATA LENGTH. 31920020 AR RWRKREG5,REIGHT ADD COUNT LENGTH 31930020 O RWRKREG5,MSKFLGON SET THE FLAGS 31940020 SPACE 1 31950020 STM RWRKREG4,RWRKREG5,0(RWTRDCCW) STORE CCW IN LIST 31960020 CLC 6(2,RWRKREG1),ZERO1 IS DATA LENGTH = 0 31970020 BC 7,ZEROFLG NO, NOT EOF RECORD 31980020 CLI 5(RWRKREG1),X'00' IS KEY LENGTH = 0 31990020 BC 7,ZEROFLG NO,NOT EOF RECORD 32000020 MVI 0(RWTRDCCW),X'12' EOF REC, CHANGE OP CODE 32010020 ZEROFLG N RWRKREG5,MSKFLGOF ZERO OUT THE FLAGS 32020020 SPACE 1 32030020 STH RWRKREG5,SAVEVTOC STORE TO DETERMINE IF DOUBLE WD 32040020 TM SAVEVTOC+1,X'07' IS DATA ON DOUBLE WORD BOUNDARY 32050020 BZ AROUNDDW YES, DOUBLE WORD 32060020 NI SAVEVTOC+1,X'F8' FORCE TO DOUBLE WORD 32070020 LH RWRKREG5,SAVEVTOC PUT BACK IN REGISTER 32080020 AR RWRKREG5,REIGHT NO, ADD EIGHT-AFTER FORCE 32090020 AROUNDDW AR RWRKREG4,RWRKREG5 MODIFY CCW ADDRESS 32100020 AR RWRKREG2,RWRKREG5 ACCUMULATE COUNTS 32110020 LA RWRKREG1,8(RWRKREG1) UPDATE COUNT BUFFER POINTR 32120020 SR RWRKREG5,RWRKREG5 32130020 SPACE 1 32140020 BXLE RWTRDCCW,REIGHT,NEWRDCKD UPDATE CCW ADR POINTER 32150020 * RETURN IF NOT THROUGH 32160020 MVI 4(RSTOPLST),X'20' SET CHAIN COMMAND BIT OFF. 32170020 EJECT 32180020 * ******************** 32190020 * * MOVE READ CCWS * 32200020 * ******************** 32210020 SPACE 32220020 * 1) MOVE CCW LIST. 32230020 SPACE 32240020 * 2) IF 2301, MOVE LIST TO AREA IN HIGH CORE. 32250020 SPACE 32260020 * 3) START EXECUTION OF READ COUNT-KEY-DATA CCW LIST. 32270020 SPACE 32280020 SPACE 32290020 READCCWS LA RWRKREG4,8(RSTOPLST) GET END FOR FINDING COUNT. 32300020 LA RWRKREG5,SEEKCCW GET BEGINNING (MOVE FROM). 32310020 SR RWRKREG4,RWRKREG5 DETERMINE COUNT. 32320020 LA RWRKREG6,WTRDCCW2 GET BEGINNING (MOVE TO). 32330020 CLI UCBFRM,X'05' DUMP OF 2301 DRUM. 32340020 BC 7,MOVEREAD NO--MOVE TO ADDRESS IS OK. 32350020 A RWRKREG6,CON40K ADD 40K TO CCW ADDRESS FOR 2301 32360020 MOVEREAD LR RWRKREG8,RWRKREG6 SAVE BEGINNING CCW ADDRESS. 32370020 BAL REG1,SETUP GO TO MOVE CCWS OR DATA 32380020 MVC SEEKCCW(4),HAR0CCW SET UP SEEK ADDRESS 32390020 SPACE 32400020 LA RWRKREG6,16(RWRKREG8) POINT TO SEARCH R0 CCW. 32410020 ST RWRKREG6,8(RWRKREG6) SET UP TIC ADDRESS. 32420020 MVI 8(RWRKREG6),X'08' RESET TIC OP CODE. 32430020 SPACE 32440020 LR RCAW,RWRKREG8 CCW LIST ADDRESS. 32450020 LA RUCBPTR,UCBFRM UCB FOR DIRECT ACCESS DEVICE. 32460020 BAL LINK9,STARTIO1 READ COUNT-KEY-DATA THIS TRACK. 32470020 EJECT 32480020 * ******************** 32490020 * * BUILD WRITE CCWS * 32500020 * ******************** 32510020 SPACE 1 32520020 * 1) CHANGE FIRST CCW (DASD) TO READ R0. 32530020 SPACE 1 32540020 * 2) STORE DASD CCW LIST LENGTH IN COUNT FIELD OF 32550020 * WRITE (TAPE) CCW. 32560020 SPACE 1 32570020 * 4) STORE DATA LENGTH IN WRITE (TAPE) DATA CCW. 32580020 SPACE 2 32590020 PREPRWRT STH RWRKREG2,WRTTPDTA+6 STORE TOTAL DATA CNT IN CCW 32600020 LA RWTRDCCW,DTALENG-8 GET ADDRESS OF DATA CONCERNING 32610020 * CCW LIST AS WELL AS THE CCW 32620020 * LIST 32630020 SPACE 1 32640020 LA RWRKREG1,32(RSTOPLST) GET STOPING FACTOR 32650020 AR RWRKREG1,RSTOPLST DOUBLE IT FOR 2 SUBTRACTS 32660020 S RWRKREG1,ASEARIDE SUBT ADDR OF SEARIDE 32670020 SR RWRKREG1,RWTRDCCW SUBTRACT ADDR OF BEGIN OF LIST 32680020 STH RWRKREG1,WRTTPCCW+6 STORE IN COUNT FIELD 32690020 SPACE 2 32700020 EJECT 32710020 * ***************************** 32720020 * * CHANGE DASD CCWS TO WRITE * 32730020 * ***************************** 32740020 SPACE 1 32750020 * 1) CHECK IF WRITE SPECIAL IS NECESSARY. IF SO, 32760020 * MAKE LAST CCW WRITE SPECIAL. 32770020 SPACE 1 32780020 * 2) IF NOT, MAKE LAST CCW WRITE COUNT,KEY,DATA. 32790020 SPACE 1 32800020 * 3) MAKE FIRST CCW WRITE R0. 32810020 SPACE 1 32820020 * 4) MAKE ALL OTHERS WRITE COUNT,KEY,DATA. 32830020 SPACE 1 32840020 * 5) GO TO PROPER WRITE ROUTINE. 32850020 SPACE 1 32860020 TSTWRTSP LA RWRKREG4,8(RSTOPLST) GET END FOR FINDING COUNT 32870020 LA RWRKREG5,SEARIDE GET BEGINNING (MOVE FROM) 32880020 SR RWRKREG4,RWRKREG5 DETERMINE COUNT 32890020 LA RWRKREG6,8(RSTOPLST) GET BEGINNING (MOVE TO) 32900020 LA RWRKREG8,8(RSTOPLST) GET END OF READ BACK CHK FOR 32910020 LA REIGHT,8 SET UP INCREMENTING FACTOR. 32920020 AR RWRKREG8,RWRKREG4 SEARCH FOR RDBKCK FOR R0 32930020 MVI 4(RSTOPLST),X'60' CHAIN READS TO WRITES 32940020 SPACE 1 32950020 BAL REG1,SETUP GO TO MOVE CCWS OR DATA 32960020 LR RWRKREG3,RSTOPLST SAVE RSTOPLST 32970020 LA RWTRDCCW,32(RSTOPLST) GET BEG OF NEW LIST OF READ CCW 32980020 S RSTOPLST,ASEARIDE GET LENGTH OF LIST OF READS 32990020 AR RSTOPLST,RWTRDCCW GET END ADDRESS 33000020 SPACE 1 33010020 CNGTOSKP OI 4(RWTRDCCW),X'10' TURN ON SKIP 33020020 BXLE RWTRDCCW,REIGHT,CNGTOSKP RETURN 33030020 SPACE 1 33040020 LR RSTOPLST,RWRKREG3 RESTORE RSTOPLST 33050020 MVC 0(24,RWRKREG8),SEARIDE PREPARE READ BACK CHECK FOR R0 33060020 ST RWRKREG8,8(RWRKREG8) STORE ADDRESS IN TIC 33070020 MVI 8(RWRKREG8),X'08' RESET TIC OP CODE. 33080020 MVC WTRDDATA(8),TICNOP NOP THE FIRST RD (RO) 33090020 MVI 24(RSTOPLST),X'05' CHANGE FIRST READ TO WRITE 33100020 AR RWRKREG3,REIGHT GET ADDRESS 33110020 ST RWRKREG3,16(RSTOPLST) STORE ADDRESS IN TIC 33120020 MVI 16(RSTOPLST),X'08' RESET TIC OP CODE 33130020 MVI L20(RWRKREG8),SKBIT TURN SK ON IN LAST RD R0 S20201 33140020 SPACE 1 33150020 LA RWTRDCCW,WTRDCCW GET BEGINNING OF RCKD'S 33160020 SPACE 1 33170020 SPACE 1 33180020 CNGTOWRT MVI 0(RWTRDCCW),X'1D' CHANGE ALL READS EXCEPT LAST TO 33190020 BXLE RWTRDCCW,REIGHT,CNGTOWRT WRITES 33200020 GOWRITE TM TAPESW,X'01' DUMP TO TAPE 33210020 BC 1,DMPDASD1 YES--GO TO WRITE ON TAPE. 33220020 TSTCOUNT CLI UCBFRM+1,X'00' NO--HAS READ COUNT COMPLETED8684 33230020 BC 7,TSTCOUNT WAIT 8684 33240020 SPACE 1 8684 33250020 TM UCBFRM+25,X'01' WAS THIS RECORD OVERFLOW 8684 33260020 BCR 8,RLINK2 NO--CONTINUE 8684 33270020 MVI 0(RSTOPLST),X'01' YES,CHANGE LAST CCW TO WRITE 8684 33280020 * SPECIAL COUNT KEY DATA 8684 33290020 NI UCBFRM+25,X'FE' TURN OFF OVERFLOW BIT 8684 33300020 BR RLINK2 GO TO PROPER ROUTINE 8684 33310020 SPACE 1 33320020 EJECT 33330020 * ********************** 33340020 * * RLINK2 MAIN LOOPS * 33350020 * ********************** 33360020 * * TO/FROM TAPE * 33370020 * **************** 33380020 * * TO 2311 * 33390020 * *********** 33400020 SPACE 2 33410020 * ROUTINES TO 33420020 SPACE 1 33430020 * 1) WRITE ON TAPE IN DUMP DASD - TAPE 33440020 * OR 33450020 * 2) READ FROM TAPE IN RESTORE TAPE - DASD 33460020 * OR 33470020 * 3) WRITE ON 2311 IN DUMP 2311 - 2311 33480020 SPACE 2 33490020 DMPDASD1 LA RCAW,WRTTPCCW-8 CCWS FOR TAPE. 33500020 LA RUCBPTR,UCBTO TAPE UCB. 33510020 BAL LINK9,STARTIO1 START 1ST TAPE RECORD. 33520020 TESTTAPE CLI UCBTO+1,X'00' HAS THE I/O COMPLETED. 33530020 BC 7,TESTTAPE NO--WAIT. 33540020 CLI UCBFRM+1,X'00' HAS READ CKD COMPLETED. 33550020 BC 7,TESTTAPE NO--WAIT. 33560020 SPACE 1 33570020 TM UCBFRM+25,X'01' WAS THIS RECORD OVERFLOW 8327 33580020 BZ BULDCCW1 GO BUILD CCWS FOR NEXT TRK 8327 33590020 * 8327 33600020 * THIS ROUTINE WILL REWRITE THE CCW RECORD TO TAPE, 8327 33610020 * IN THE CASE WHERE THERE IS AN OVERFLOW RECORD ON THE TRACK. 8327 33620020 * 8327 33630020 MVI 0(RSTOPLST),X'01' WRT CKD IS NOW WRT SPEC CKD 8327 33640020 L BASE10,SYSBAS INSURE BASE REGISTER 10 8327 33650020 LA RCAW,BSPACE BACKSPACE OVER THE CCW REC 8327 33660020 LA RUCBPTR,UCBTO TAPE UCB 8327 33670020 BAL LINK9,STARTIO BACKSPACE 8327 33680020 NI UCBFRM+25,X'FE' TURN OFF THE OVERFLOW BIT 8327 33690020 B DMPDASD1 RE-WRITE THE CCW RECORD 8327 33700020 SPACE 2 33710020 RSTRTAPE LA RCAW,RDTPCCW-8 PREPARE TO 33720020 LA RUCBPTR,UCBFRM READ CONTROL FIELD 33730020 MVI TAPESW,X'01' SET SWITCH TO TAPE RESTORE. 33740020 SPACE 1 33750020 RSTRTAP1 BAL RLINK1,STARTIO 33760020 CLI SW64K,X'FF' IS THIS A BUFFERED OPERATION 33770020 BNE TSTDISK2 NO--GO READ TAPE AND DISK. 33780020 MVC CORE+2(2),UCBFRM+22 SAVE RESIDUAL COUNT OF CCW READ 33790020 LA RCAW,RDTPDTA-8 CCWS FOR READING DATA FROM TAPE 33800020 BAL RLINK1,STARTIO READ THE DATA INTO HIGH BUFFER 33810020 TESTDISK CLI UCBTO+1,X'FF' YES--IS THE DISK COMPLETE. 33820020 BE TESTDISK NO--AWAIT END OF PREVIOUS I/O. 33830020 BAL RLINK2,CKALT1 GO TO CHECK ALTERNATE TRACK 33840020 L RWRKREG4,RDTPCCW+4 GET COUNT FROM CCW 33850020 LA RWRKREG4,0(RWRKREG4) ZERO HIGH BYTE 33860020 S RWRKREG4,CORE GET NUMBER OF BYTES TO MOVE 33870020 LA RWRKREG6,DTALENG GET BEGINNING (MOVE TO ) 33880020 L RWRKREG5,DTALENG1 GET BEGINNING (MOVE FROM) 33890020 BAL REG1,SETUP GO TO MOVE CCWS OR DATA 33900020 SPACE 33910020 SPACE 33920020 L RWRKREG4,RDTPDTA+4 GET COUNT FROM CCW 33930020 LA RWRKREG4,0(RWRKREG4) ZERO HIGH BYTE 33940020 MVC CORE+2(2),UCBFRM+22 SAVE RESIDUAL COUNT OF DATA RD 33950020 S RWRKREG4,CORE GET NUMBER OF BYTES TO MOVE 33960020 LA RWRKREG6,DTABUFF GET BEGINNING (MOVE TO ) 33970020 L RWRKREG5,DTABUFF1 GET BEGINNING (MOVE FROM) 33980020 BAL REG1,SETUP GO TO MOVE CCWS OR DATA 33990020 SPACE 34000020 MODTKADT ST RTRKADR,CCHH SET UP TRACK ADDRESS. 34010020 MVC R0DATA(8),DTABUFF MOVE R0 DATA. 34020020 CL RTRKADR,ENDADR ARE WE FINISHED. 34030020 BNL EOJ1 YES-GO TO END OF JOB. 34040020 BAL RLINK1,CNGCYLT INCREMENT TRACK ADDRESS. 34050020 WRTDISK LA RCAW,SEEKCCW DISK CCW LIST. 34060020 LA RUCBPTR,UCBTO DEVICE TO BE WRITTEN ON. 34070020 BAL LINK9,STARTIO1 START WRITE ON DISK. 34080020 BUFOPTST CLI SW64K,X'FF' IS THIS A BUFFERED OPERATION. 34090020 BE RSTRTAPE YES-GO READ TAPE. 34100020 TSTDISK1 CLI UCBTO+1,X'FF' IS THE DISK OPERATION COMPLETE. 34110020 BE TSTDISK1 NO--AWAIT COMPLETION. 34120020 B CKALT1 GO TO CHECK ALTERNATE TRACK 34130020 TSTDISK2 LA RCAW,RDTPDTA-8 PREPARE TO READ DATA FIELD. 34140020 BAL RLINK1,STARTIO READ TAPE 34150020 B MODTKADT CONTINUE 34160020 EJECT 34170020 * ********************** 34180020 * *2311 TRACK CONTROL * 34190020 * ********************** 34200020 SPACE 2 34210020 * THE LENGTH OF THE PORTION OF THE @DATA FIELD@ OF 34220020 * THE NON 2311 DASD CONTAINED ON EACH 2311 TRACK IS 34230020 * ENTERED AT DTALENG, DTALENG+2, ... 34240020 SPACE 1 34250020 * THIS WILL ENABLE THE WRITE/READ 2311 ROUTINE TO 34260020 * TELL HOW MANY TRACKS ARE USED FOR THIS DASD TRACK. 34270020 SPACE 1 34280020 * ANY PORTION OF THE @DTALENG@ AREA THAT IS NOT 34290020 * USED MUST BE ZEROED OUT, SINCE A @TEST FOR ZERO@ 34300020 * WILL BE THE MEANS OF TELLING WHEN THE LAST 2311 34310020 * TRACK HAS BEEN WRITTEN/READ. 34320020 SPACE 2 34330020 DMP2302 MVC WRDSKCCW(64),DMYWTDK SET UP THE WRITE 'DISK' CCW 34340020 * LIST FOR 2311 34350020 TESTDA CLI UCBFRM+1,X'00' HAS THE READ CKD COMPLETED. 34360020 BNE TESTDA NO--AWAIT COMPLETETION 34370020 OI RCCWRBC1+4,X'10' SET 34380020 OI RCCWRBC2+4,X'10' SKIP 34390020 OI RCCWRBC3+4,X'10' BIT 34400020 LA RUCBPTR,UCBTO GET UCB POINTER 34410020 MVC DTALENG-4(2),TWO56+2 SET R=1 - KEYLENGTH=0 34420020 MVC CNTFIELD+4(2),FIVE12 SET R=2 - KEY LENGTH=0 34430020 CL RTRKADR1,TOTLTRK CHANGE OF DISK PACKS NEEDED 34440020 BNL SETLIMIT YES, PREPARE TO DO SO 34450020 LH RWRKREG3,TRECCNT GET MAX LENGTH FOR 2 RECORDS 34460020 STH RWRKREG1,DTALENG-2 FILL R1'S COUNT FIELD. 34470020 LA RWRKREG1,8(RWRKREG1) MODIFY CCW LIST +FUDGE TO 34480020 STH RWRKREG1,WRDSKCCW+6 STORE THE CCW LIST LENGTH+FUDGE 34490020 * IN WRITE R1 CCW COUNT FIELD 34500020 STH RWRKREG1,RCCWRBC1+6 STORE THE CCW LIST LENGTH+FUDGE 34510020 * IN RDBKCK CCW COUNT FIELD 34520020 SR RWRKREG3,RWRKREG1 SUBTRACT ABOVE COUNT FROM MAX 34530020 * LENGTH FOR TWO RECORDS 34540020 STH RWRKREG2,CNTFIELD+6 STORE DATA LENGTH IN COUNT(CKD) 34550020 STH RWRKREG2,WDSKCCW2+6 STORE DATA LENGTH IN COUNT 34560020 * FIELD OF R1 CCW 34570020 STH RWRKREG2,RCCWRBC3+6 STORE DATA LENGTH IN COUNT 34580020 * FIELD OF RDBKCK R2 34590020 SPACE 1 34600020 SR RWRKREG1,RWRKREG1 PREPARE RWRKREG1 FOR ANOTHER 34610020 * ROUND 34620020 SPACE 1 34630020 CLR RWRKREG3,RWRKREG2 WAS DATA LENGTH WITHIN CAPACITY 34640020 * OF SINGLE TRACK 34650020 BNL STRTDSK YES, START WRITE 34660020 SPACE 1 34670020 STH RWRKREG3,CNTFIELD+6 NO, REPLACE DATA LENGTH IN CNT 34680020 STH RWRKREG3,WDSKCCW2+6 AND REPLACE DATA LENGTH BY. 34690020 * RESIDULE COUNT OF TRACK 34700020 STH RWRKREG3,RCCWRBC3+6 ALSO, READ BACK CHECK CCW 34710020 SPACE 2 34720020 LOOPREC STH RWRKREG3,DTALENG(RWRKREG1) STORE NO OF BYTES FOUND ON 34730020 * TRACK IN FUDGE PART OF CCW 34740020 * LIST 34750020 LA RWRKREG1,2(RWRKREG1) MODIFY INDEX IN CASE NEXT TRACK 34760020 * WILL NOT HOLD RESIDULE DATA 34770020 SR RWRKREG2,RWRKREG3 DETERMINE NO OF BYTES OF DATA 34780020 * LEFT 34790020 STH RWRKREG2,DTALENG(RWRKREG1) STORE RESIDULE COUNT IN SAVE 34800020 * PART OF CCW LIST ETC. 34810020 LH RWRKREG3,TRECCNT GET MAX COUNT 34820020 CLR RWRKREG3,RWRKREG2 WILL THIS TRACK CONTAIN 34830020 * RESIDULE COUNT 34840020 BNL STRTDSK YES, START WRITE 34850020 B LOOPREC REPEAT PROCESS 34860020 SPACE 2 34870020 * THE DUMPING OF THE 2301 ONTO 2311 AND THE 2303 ONTO 2311 34880020 * IS EXACTLY THE SAME ROUTINE AS DUMPING 2302 ONTO 2311 SO 34890020 * THESE ARE EQUATED TO 'DMP2302' 34900020 SPACE 2 34910020 DMP2301 EQU DMP2302 34920020 SPACE 1 34930020 DMP2303 EQU DMP2302 34940020 EJECT 34950020 * ****************************** 34960020 * * WRITE/READ 2311(TRANSIENT) * 34970020 * ****************************** 34980020 SPACE 2 34990020 * 1) FIRST TIME THROUGH READ/WRITE R0 AND R1 IS IMPLEMENTED 35000020 SPACE 1 35010020 * 2) THEN DTALENG+2(TIMES THROUGH) IS CHECKED AND IF NON ZERO 35020020 * THE READ/WRITE R0 CCW IS MODIFIED FROM DATA CONTAINED IN 35030020 * DTALENG FIELD AND READ/WRITE IS STARTED FOR NEXT TRACK 35040020 SPACE 2 35050020 STRTDSK LA RWRKREG1,DTALENG GET ADDRESS OF 'NO RECORDS' CNT 35060020 LA RCAW,SEEK1CCW GET CCW LIST ADDRESS 35070020 LA RLINK1,CKALT2 ADDRESS TO CK IF ALT TRK NEEDED 35080020 SPACE 1 35090020 MODTKAD1 ST RTRKADR1,CCHH1 STORE TRACK AND CYLINDER NO. 35100020 ST RTRKADR1,CNTADR1+2 IN R1 COUNT AND SEEK FIELD 35110020 ST RTRKADR1,DTALENG-8 ALSO STORE IT IN COUNT FIELD. 35120020 * OF CKD (CCWLIST + ) 35130020 CLC HH1(2),BUMPCYL CHANGE OF CYLINDER NEEDED 35140020 BE CNGCYL2 YES, DO SO 35150020 LA RTRKADR1,1(RTRKADR1) NO, MODIFY TRACK ADDRESS 35160020 B STARTIO READ/WRITE THE TRACK. 35170020 SPACE 1 35180020 MORETRKS CLI DTALENG,X'FF' HAS LAST TRACK BEEN PROCESSED 35190020 BE CKEOP YES 35200020 CL RWRKREG1,ADTALENG IS THIS FIRST TIME THROUGH 35210020 BNE MORTRKS1 NO 35220020 MVC RCCWRBC1(16),RCCWRBC2 MOVE CCWS UP SO WRITE ONLY ONE 35230020 MVC WRDSKCCW(48),WDSKCCW1 RECORD 35240020 L RWRKREG4,RDBKCK1 MODIFY 35250020 S RWRKREG4,EIGHT TIC 35260020 ST RWRKREG4,RDBKCK1 ADDRESS 35270020 SPACE 1 35280020 MORTRKS1 CLC 2(2,RWRKREG1),ZERO1 ARE THERE MORE TRACKS TO PROCESS 35290020 BNE GOAGAIN YES, DO SO 35300020 XC DTALENG(16),DTALENG NO, CLEAR TRACK PROCESS AREA 35310020 CL RUCBPTR,AUCBTO DUMP OR RESTORE 35320020 BNE MODTKADT RESTORE 35330020 B BUILDCCW START OPERATION OVER 35340020 SPACE 1 35350020 GOAGAIN L RWRKREG2,WRDSKCCW+8 GET PART OF CCW TO MODIFY 35360020 LH RWRKREG3,0(RWRKREG1) GET PREVIOUS COUNT 35370020 AR RWRKREG2,RWRKREG3 ADD PREVIOUS DATA COUNT TO 35380020 * PREVIOUS DATA ADDRESS. 35390020 ST RWRKREG2,WRDSKCCW+8 RETURN THAT PART 35400020 ST RWRKREG2,RCCWRBC2 ALSO PUT IN READ BACK CK. 35410020 MVI RCCWRBC2,X'1E' KEEP READ CKD OP CODE 35420020 MVC WRDSKCCW+14(2),2(RWRKREG1) MOVE NEW COUNT TO COUNT FIELD 35430020 MVC RCCWRBC2+6(2),2(RWRKREG1) ALSO, TO RDBKCK 35440020 MVC CNTFIELD+6(2),2(RWRKREG1) GET COUNT OF CKD READY. 35450020 MVI CNTFIELD+4,X'01' MAKE RECORD #1 35460020 LA RWRKREG1,2(RWRKREG1) MODIFY CONTROL FIELD POINTER 35470020 B MODTKAD1 PREPARE TO STARTIO AGAIN 35480020 EJECT 35490020 RSTR2302 MVC WRDSKCCW(24),DMYRDDK SET UP THE READ 'DISK' CCW 35500020 * LIST FOR 2311 35510020 MVI WLRECSW,X'01' SWT SWITCH FOR WRONG LENGTH 35520020 LA RUCBPTR,UCBFRM GET UCB POINTER 35530020 B STRTDSK PREPARE TO READ FROM PROPER 35540020 * TRACK 35550020 SPACE 2 35560020 * THE RESTORING OF THE 2301 FROM 2311 AND THE 2303 FROM 2311 35570020 * ARE EXACTLY THE SAME ROUTINES AS RESTORING THE 2302 FROM 2311, 35580020 * SO THESE ARE EQUATED TO 'RSTR2302' 35590020 SPACE 2 35600020 RSTR2301 EQU RSTR2302 35610020 RSTR2303 EQU RSTR2302 35620020 EJECT 35630020 * *********************** 35640020 * * GENERAL SUBROUTINES * 35650020 * *********************** 35660020 SPACE 2 35670020 * ROUTINES TO CHANGE THE CCHH FROM CYLINDER M TRACK N 35680020 * (WHERE N IS MAXIMUM FOR THAT DASD) TO CYLINDER M+1 TRACK 0 35690020 SPACE 1 35700020 SPACE 1 35710020 CHANGCYL AL RTRKADR,F1 UPDATE TRACK ADDRESS 35720020 CLC CCHH+3(1),TRKPCYLF+1 LAST TRACK 35730020 BCR 4,RLINK1 NO, RETURN 35740020 SPACE 1 35750020 A RTRKADR,CYLINCRF CHANGE ADDRESS TO NEXT CYLINDER 35760020 B CK2321 CHECK IF 2321 35770020 SPACE 2 35780020 CNGCYLT AL RTRKADR,F1 UPDATE TRACK ADDRESS 35790020 CLC CCHH+3(1),TRKPCYLT+1 LAST TRACK 35800020 BCR 4,RLINK1 NO, RETURN 35810020 SPACE 1 35820020 AL RTRKADR,CYLINCRT CHANGE CYLINDERS 35830020 SPACE 2 35840020 CK2321 CLI CCHH+2,X'04' IS 2321 OR LAST CYL IF IS 35850020 BCR 7,RLINK1 NO 35860020 SPACE 1 35870020 AL RTRKADR,STC2321 INCRIMENT STRIP 35880020 CLI CCHH+1,X'09' LAST STRIP 35890020 BCR 7,RLINK1 NO,RETURN 35900020 SPACE 1 35910020 AL RTRKADR,SCC2321 INCRIMENT SUBCELL 35920020 BR RLINK1 RETURN 35930020 SPACE 1 35940020 CNGCYL2 A RTRKADR1,CYLINCR1 CHANGE CYLINDERS. 35950020 B STARTIO 35960020 EJECT 35970020 * ************************** 35980020 * * CHECK ALTERNATE TRACKS * 35990020 * ************************** 36000020 SPACE 2 36010020 * THE CHECK ALTERNATE TRACK ROUTINES ARE USED IN 36020020 * THE FOLLOWING SITUATIONS. 36030020 SPACE 1 36040020 * CKALT ------- BAD TRACK IN READ ON DASD IN A 36050020 SPACE 1 36060020 * DASD -- TAPE 36070020 * DUMP 36080020 * 2311 -- 2311 36090020 SPACE 1 36100020 * CKALT1 ------ BAD TRACK IN WRITE ON 2311 IN A 36110020 SPACE 1 36120020 * TAPE -- 2311 36130020 * RESTORE 36140020 * 2311 -- 2311 36150020 SPACE 1 36160020 * CKALT2 ------ BAD TRACK IN WRITE/READ ON 2311 IN 36170020 SPACE 1 36180020 * NON 2311 36190020 * DASD - 2311 DUMP 36200020 SPACE 1 36210020 * NON 2311 36220020 * 2311 -- DASD RESTORE 36230020 SPACE 1 36240020 * CKALT--DEVICE FROM ON DUMP 36250020 SPACE 1 36260020 * CKALT CHECK S FOR BAD TRACK AND PLACES THE ALTERNATE TRACK ADDRESS 36270020 * IN CCHH AND RETURNS FOR ANOTHER READ TRY 36280020 SPACE 1 36290020 * IT SHOULD BE NOTED THAT IF CCHH IS FOR ALTERNATE TRACK THEN THE 36300020 * PROPER CCHH MUST BE BROUGHT BACK FOR USE IN RESTORE. 36310020 SPACE 1 36320020 * CKALT IS ENTERED ONLY WHEN UNIT CHECK IS ENCOUNTERED ON READ COUNT 36330020 * AND PROTECTION BIT IS NOT ON. HENCE IF THE TEST OF BAD TRACK 36340020 * FAILS, A STANDARD ERROR IS ENCOUNTERED. 36350020 SPACE 2 36360020 CKALT LA RUCBPTR,UCBFRM UCB FOR DIRECT ACCESS DEVICE. 36370020 LA RCAW,SEEKALT PREPARE TO READ HA + R0. 36380020 BAL RLINK1,STARTIO 36390020 SPACE 1 36400020 TM ALTBUFF,X'01' WAS TRACK READ ACTUALLY ALT 36410020 BO CNGRDCKD YES, RETURN TO BUILD RD CKD 36420020 MVC CCHHALT(4),ALTBUFF+5 GET ADDRESS OF ALTERNATE TRACK 36430020 LA RCAW,ALTCCW SEEK ACTUAL ALT; SID RELATIVE 36440020 BAL RLINK1,STARTIO READ COUNTS FROM ALTERNATE 36450020 TM UCBFRM+24,X'02' A TRACK CONDITION CHECK? 36460020 MVC SEEKCCW(4),ALTCCW SET UP SEEK ADDRESS 36470020 BC 1,CNGRDCKD YES-GO READ COUNT-KEY-DATA 36480020 B ANALSENS NO--GO CHECK FOR FILE PROTECT 36490020 EJECT 36500020 * CKALT1--DEVICE TO ON RESTORE. 36510020 SPACE 1 36520020 * CKALT1 NOTES IF BAD WRITE CAUSED BY BAD TRACK. 36530020 * IF SO, THE FOLLOWING PROCEEDURE IS FOLLOWED. 36540020 * 1)WRITE R0 COMMAND IS SAVED 36550020 * 2)READ (R0) COUNT COMMAND (WITH CHAIN COMMAND) 36560020 * IS DUBBED IN 36570020 * 3)ALTERNATE TRACK ADDRESS GOTTEN FROM COUNT 36580020 * FIELD 36590020 * 4)WRITE R0 COMMAND PLACED BACK AND ANOTHER WRITE STARTED 36600020 SPACE 2 36610020 CKALT1 TM UCBTO+24,X'02' BAD TRACK CONDITION? 36620020 BC 7,GETCCW YES 36630020 SPACE 1 36640020 CKALT1A MVI ALTSW,X'00' SET 'ALT WRT' SWITCH OFF 36650020 MVI UCBTO+24,X'00' CLEAR UCB "SENSE" AREA 36660020 LA RUCBPTR,UCBFRM POINT TO 'FROM' UCB 36670020 TM TAPESW,X'03' NO, WAS THIS RESTORE FROM TAPE 36680020 BCR 5,RLINK2 YES, RETURN TO READ TAPE 36690020 B BUILDCCW NO, THEN WAS DUMP (2311-2311) 36700020 * RETURN AND BUILD ANOTHER CNT 36710020 * CCW LIST 36720020 SPACE 1 36730020 GETCCW TM ALTSW,X'01' HAS ALTERNATE TRACK BEEN WRITTN 36740020 BO CKALT1A YES, RETURN 36750020 MVI ALTSW,X'01' SET SWITCH INDICATING ALT WRT. 36760020 SPACE 1 36770020 LA RUCBPTR,UCBTO POINT TO 'TO' UCB 36780020 LA RCAW,SEEKALT PREPARE TO READ HA AND R0 36790020 BAL RLINK1,STARTIO 36800020 SPACE 1 36810020 TM ALTBUFF,X'01' WAS TRACK READ ACTUALLY ALT 36820020 BO CKALT1A YES 36830020 SPACE 1 36840020 HAVER0 MVC CCHHALT(4),ALTBUFF+5 GET ADDRESS OF ALT FOR SEEK 36850020 B ALTCKRTN CK. ALT. TRK. INFORMATION. 4332 36860020 CONTINU EQU * RETURN PT. 4332 36870020 SPACE 1 36880020 MVC PRWD(18),BAD INSERT BAD TRACK MESSAGE 36890020 UNPK PRWD+20(9),CCHH(5) INSERT ORIGINAL TRACK 36900020 BAL RLINK1,FINSPRNT FINISH 36910020 CLC CCHH(4),ZERO IS TRACK ZERO BAD. 8348 36920020 BNE ALTRACK NO 8348 36930020 MVC PRWD(77),ALTMSG YES--SET UP MESSAGE. 8348 36940020 LA REG1,77 LENGTH OF MESSAGE. 8348 36950020 BAL RLINK1,PRNT PRINT THE MESSAGE. 8348 36960020 SPACE 1 36970020 ALTRACK MVC PRWD(18),ALT GIVE ALTERNATE MESSAGE. 8348 36980020 UNPK PRWD+20(9),CCHHALT(5) INSERT ALTERNATE ADDRESS 36990020 BAL RLINK1,FINSPRNT FINISH 37000020 SPACE 1 37010020 BAL RLINK1,PRNT SPACE A LINE 37020020 SPACE 1 37030020 LA RLINK1,CKALT1 GET RETURN ADDRESS 37040020 LA RCAW,ALTCCW SEEK ACTUAL; SID RELATIVE 37050020 B STARTIO 37060020 SPACE 2 37070020 FINSPRNT TR PRWD+20(8),IOTAB-240 COVERT TO GRAPHICS. 37080020 MVI PRWD+28,C' ' CLEAR UNPK GARBAGE 37090020 LA REG1,30 37100020 B PRNT 37110020 EJECT 37120020 * CKALT2 IS USED WHEN BAD TRACK IS ENCOUNTERED 37130020 * ON 2311 DURING "NON-2311 TO 2311" DUMP OR 37140020 * "2311 TO NON-2311" RESTORE 37150020 SPACE 1 37160020 CKALT2 TM UCBTO+24,X'02' BAD TRACK SWITCH ON 37170020 BC 7,GETCCW2 YES 37180020 B MORETRKS NO, RETURN 37190020 SPACE 1 37200020 GETCCW2 MVC SWITCHRD+8(8),SEARCCW1 SAVE SEARCH R0 CCW. 37210020 MVC SEARCCW1(8),READR0CT REPLACE WITH READ R0 COUNT 37220020 BAL RLINK1,STARTIO 37230020 SPACE 1 37240020 HAVER02 MVC SEARCCW1(8),SWITCHRD+8 RESTORE SEARCH R0 CCW. 37250020 MVC NEWTRK+2(4),SWITCHRD SEEK ADDRESS FOR ALTERNATE. 37260020 LA RCAW,GOTOALT ADDRESS OF CCW LIST. 37270020 BAL RLINK1,STARTIO PUT THE INFO ON AN ALTERNATE. 37280020 LA RCAW,SEEK1CCW RESTORE CCW LIST POINTER 37290020 B MORETRKS GO PROCESS SOME MORE. 37300020 SPACE 1 37310020 EJECT 37320020 * ***************** 37330020 * * MULTIPLE TAPE * 37340020 * ***************** 37350020 SPACE 2 37360020 * UPON ENCOUNTERING UNIT EXCEPTION, CAUSE IS DETERMINED 37370020 * TEST IS MADE TO DETERMINE IF TAPE IS INPUT OR OUTPUT 37380020 SPACE 1 37390020 * OUTPUT 37400020 * 1) CHECK IS MADE TO DETERMINE IF BOTH RECORDS 37410020 * FOR TRACK ARE WRITTEN (CCW LIST AND BUFFER) 37420020 * 2) GET NEW REEL MESSAGE SET UP 37430020 * 3) CONTROL RECORD IS WRITTEN FOR RESTORE 37440020 SPACE 1 37450020 * INPUT 37460020 * 1) CONTROL RECORD IS READ 37470020 * 2) CHECK IS MADE TO DETERMINE IF DONE 37480020 * 3) TRANSFER IS MADE TO PROPER ROUTINE 37490020 SPACE 2 37500020 ENDREEL MVI EORSW,X'FF' FF MEANS END OF REEL 5274 37510020 B IORTRN LOAD I/O OLD PSW 5274 37520020 RESET15 L GR15,CCHH DECREMENT GR15 ONE TRACK 5274 37530020 L BASE10,SYSBAS INSURE BASE REGISTER 10 5274 37540020 MVI CKVOLSW,X'80' 5274 37550020 LA RWRKREG4,UCBTO GET ADDRESS OF UCB TO DEVICE 37560020 BAL RLINK1,UNIT CONVERT TO PRINTABLE FORMAT 37570020 MVC MESS1+36(3),UNITHLD+1 PREPARE TO PRINT 37580020 MVC PRWD(65),MESS1 PUT TAPE MOUNT MESSAGE IN PRWD. 37590020 LA GR1,65 LENGTH OF MESSAGE IN BYTES. 37600020 SPACE 1 37610020 L RWRKREG4,REELCTRL SET UP SWITCH TO DETERMINE 37620020 SLL RWRKREG4,1 WHEN ALL TAPES HAVE BEEN 37630020 ST RWRKREG4,REELCTRL RESTORED 37640020 ST RWRKREG4,DTABUFF PREPARE TO WRITE THEM 37650020 SPACE 1 37660020 LA RLINK2,SETWAIT PREPARE RETURN ADDRESS 37670020 B EOJ1A 37680020 SPACE 2 37690020 SPACE 2 37700020 EOJ1 MVC PRWD(58),MESS2 GET ADDR OF EOJ CCW 37710020 LA REG1,58 37720020 CL RLINK2,ADMP2302 IS DASD NON 2311 37730020 BE EOJ2 YES 37740020 LA RLINK2,WAITZ GO INT WAIT STATE FOR NEW TAPE 37750020 TM TAPESW,X'01' TAPE OR 2311 TO 2311 37760020 BZ EOJ2311 2311 37770020 SPACE 1 37780020 L RWRKREG4,REELCTRL SET UP SWITCH TO DETERMINE 37790020 SLL RWRKREG4,1 THAT ALL TAPES HAVE BEEN 37800020 LCR RWRKREG4,RWRKREG4 RESTORED 37810020 ST RWRKREG4,DTABUFF PREPARE TO WRITE 37820020 EOJ1A MVC WRTTPDTA+6(2),NOISECK TRAILER REC 24 BYTES A53319 37830021 LA RUCBPTR,UCBTO 37850020 SPACE 1 37870020 LA RCAW,WRTTPDTA-8 RESTORE (REELS) CONTROL 37880020 BAL RLINK1,STARTIO ON TAPE 37890020 SPACE 1 37900020 LA RCAW,WTMCCW 37910020 BAL RLINK1,STARTIO 37920020 BAL RLINK1,STARTIO TWO TAPE MARKS AT THE END. 37930020 SPACE 1 37940020 EOJA MVI TSWITCH,X'01' THIS IS TAPE INOR OUT 37950020 BAL RWRKREG1,ENDOFJOB GO PRINT END OF JOB MESSAGE 37960020 LA RCAW,XREWCCW REWIND THE TAPE 37970020 BAL RLINK1,STARTIO 37980020 BR RLINK2 SET UP PROPER WAIT 37990020 SPACE 1 38000020 ENDOFJOB BAL RLINK1,PRNT PRINT END OF JOB OR END OF 38010020 * REEL/DISK PACK 38020020 MVC DTABUFF(8),BGNADR STORE BEGINNING,END AND 38030020 ST RTRKADR,DTABUFF+8 RELATIVE BEGINNING ADDRESSES 38040020 MVC DTABUFF+12(8),PRTKCODE SET CODE TO PROTECT READING 38050020 MVC DTABUFF+20(1),FULLDPSW SAVE "FULLDUMP" SWITCH 38060020 MVC DTABUFF+21(1),UCBFRM TELL DEVICE TYPE 38070020 TM TSWITCH,X'01' TAPE INPUT OR OUTPUT? 38080020 BCR 1,RWRKREG1 YES, REWIND THE TAPE 38090020 SPACE 1 38100020 BR RLINK2 38110020 SPACE 2 38120020 WAITZ CLI UCBSYO,T2400 IS SYSOUT TAPE S20201 38130020 BE WTMSYO YES 38140020 SPACE 1 38150020 LPSW COWAIT 38160020 WTMSYO LA RCAW,WTMCCW 38170020 LA RUCBPTR,UCBSYO WRITE TAPE MARK ON SYSOUT 38180020 BAL RLINK1,STARTIO 38190020 SPACE 1 38200020 LA RCAW,XREWCCW REWIND SYSOUT 38210020 BAL RLINK1,STARTIO 38220020 SPACE 1 38230020 LPSW COWAIT GO INTO SOLID WAIT 38240020 SPACE 1 38250020 SETWAIT LA RLINK2,TOTAPE GET RETURN ADDRESS 38260020 B PREWAITA 38270020 SPACE 1 38280020 EOJ2311 LA RWRKREG1,ENDOFJOB BYPASS TAPE 38290020 MVC PRWD(59),MESS2 SET UP END OF JOB MESSAGE 38300020 LA REG1,59 38310020 SPACE 1 38320020 EOJAA CLI UCBTO+1,X'FF' IS DISK COMPLETE 38330020 BE EOJAA NO--AWAIT COMPLETION 38340020 CLI FULLDPSW,X'F0' FULL RESTORE OR 2311 DUMP 38350020 BCR 7,RWRKREG1 NO 38360020 LA RUCBPTR,UCBTO PREPARE 38370020 LA RCAW,SEARCHID TO 38380020 MVC CCHH(4),CCHHZERO ACTUAL OR ALTERNATE CCHH FOR 0 38390020 MVI CCHHR+4,X'01' SET SEARCH FOR IPL1 A36316 38396020 MVI WRTRDID+7,X'18' SET IPL1 LENGTH A36316 38402020 XC CCHHR(4),CCHHR SET SEARCH FOR TRACK ZERO 38410020 BAL RLINK1,STARTIO START IO 38420020 MVI CCHHR+4,X'02' SET SEARCH FOR IPL2 A36316 38421020 MVI WRTRDID+7,X'90' SET IPL2 LENGTH A36316 38422020 CLI SAVEVTOC+1,X'06' IS IPLTXT ON PACK A36316 38423020 BE EOJAH NO IPLTXT A36316 38424020 BAL RLINK1,STARTIO READ IPL BOOTSTRAP A36316 38425020 MVC CCHH(4),SAVEVTOC+38 GET ADDRESS OF IPL TEXT 38430020 LA RCAW,SEEKALT GET IPL TEXT TRACK 38440020 BAL RLINK1,STARTIO START IO 38450020 LA RCAW,SEARCHID 38460020 LA RLINK1,ALTBUFF+5 SET IPL TEXT CCHH ADDRESS 38470020 TM ALTBUFF,X'02' IS IPL TEXT ON ALTERNATE TRACK 38480020 BO CNGIPLBS YES 38490020 LA RLINK1,SAVEVTOC+38 SET IPL TEXT 38500020 CLC SAVEVTOC+34(4),SAVEVTOC+38 WAS IPL TEXT ON ALTERNATE TRK 38510020 BNE CNGIPLBS YES 38520020 EOJAH MVC CCHH(4),CCHHZERO ACTUAL OR ALTERNATE CCHH FOR 0 38530020 MVI CCHHR+4,X'03' SET SEARCH FOR VOLUME LABEL 38540020 BAL RLINK1,STARTIO READ IN POINTER TO VTOC. 38550020 MVI WRTRDID,X'06' CHANGE BACK TO READ ID 38560020 MVC CCHHR(5),SAVEVTOC+11 SET UP SEARCH ADDRESS. 38570020 MVC CCHH(4),SAVEVTOC+11 SET UP SEEK ADDRESS. 38580020 BAL RLINK1,STARTIO 38590020 SPACE 1 38600020 MVC SAVEVTOC+8(6),ALTDATA UPDATE ALTERNATE TRK INFORMATN 38610020 MVI WRTRDID,X'05' WRITE VTOC 38620020 BAL RLINK1,STARTIO 38630020 LA RUCBPTR,UCBFRM PREPARE REWIND IF NECESSARY 38640020 BR RWRKREG1 PREPARE TO PRINT EOJ MESSAGE 38650020 SPACE 1 38660020 CNGIPLBS MVC CCHH(4),CCHHZERO ADDRESS OF IPL BOOTSTRAP. 38670020 MVC SAVEVTOC+34(4),0(RLINK1) TO CHANGE AND WRITE 38680020 MVI WRTRDID,X'05' PROPER TRACK IN BOOT STRAP 38690020 XC SAVEVTOC+50(13),SAVEVTOC+50 INSURE ALTBUFF IS CLEARED. 38700020 BAL RLINK1,STARTIO START IO 38710020 MVI WRTRDID,X'06' CHANGE BACK TO READ 38720020 MVI WRTRDID+7,X'60' SET COUNT 38730020 B EOJAH RETURN 38740020 EJECT 38750020 SETLIMIT L RWRKREG4,REELCTRL SET UP SWITCH TO DETERMINE 38760020 SLL RWRKREG4,1 THIS DISK PACK 38770020 ST RWRKREG4,REELCTRL HAS BEEN 38780020 ST RWRKREG4,DTABUFF WRITTEN 38790020 MVI DTALENG,X'FF' SET UP "END OF DISK" SWITCH 38800020 * FOR RESTORE 38810020 LA RWRKREG1,40 RESET 38820020 STH RWRKREG1,RCCWRBC1+6 CCW LIST 38830020 S RWRKREG1,EIGHT FOR 38840020 STH RWRKREG1,RCCWRBC3+6 TRAILER RECORDS 38850020 STH RWRKREG1,DTALENG-2 ALSO RESET 38860020 STH RWRKREG1,CNTFIELD+6 COUNT FIELDS 38870020 LA RWRKREG4,UCBTO GET UCB ADDRESS 38880020 BAL RLINK1,UNIT TELL OPERATOR TO MOUNT NEW PACK 38890020 SPACE 1 38900020 CL RTRKADR,ENDADR END OF VOLUME OR END OF JOB 38910020 L RTRKADR,CCHH RESET TRACK ADDRESS 38920020 BL STRTDSK END OF VOLUME ONLY 38930020 L RTRKADR1,CCHH1 RESET TRACK ADDRESS IN CASE IT 38940020 * WAS MODIFIED BY "EOJ2" TO 38950020 * FORCE END OF PACK 38960020 B STRTDSK RETURN TO WRITE TRAILER RECORD 38970020 SPACE 1 38980020 CKEOP CL RUCBPTR,AUCBTO IS THIS "END OF PACK" FOR 38990020 * DUMP OR RESTORE 39000020 BNE RDNEWD RESTORE 39010020 TM EOJSWTCH,X'01' IS IT EOJ OR END OF PACK 39020020 BO EOJ3B END OF JOB 39030020 MVC DTABUFF(8),BGNADR DUMP, STORE BEGINNING, END 39040020 ST RTRKADR,DTABUFF+8 AND RELATIVE BEGINNING ADDRES 39050020 MVC DTABUFF+12(8),PRTKCODE SET "IS THIS RSTR PK" SWITCH 39060020 MVC DTABUFF+20(1),FULLDPSW SAVE "FULLDUMP" SWITCH 39070020 MVC DTABUFF+21(1),UCBFRM TELL DEVICE TYPE 39080020 LA RLINK2,TO2311 SETUP TO START NEXT ROUND 39090020 MVI DTALENG,X'00' CLEAR END OF PACK SWITCH. 39100020 B PREWAIT DUMP 39110020 RDNEWD LA RWRKREG4,UCBFRM ADDRESS OF FROM DEVICE UCB 39120020 BAL RLINK1,UNIT TELL OPERATOR TO MOUNT NEW PAC 39130020 LA RLINK2,WAITZ SET EOJ WAIT TO BE USED IF NEC 39140020 OC REELCK(4),DTABUFF DETERMINE WHICH PACK RESTORED 39150020 CLC REELCK(4),REELMASK FINAL ONE 39160020 BE EOJ2311 YES 39170020 LA RLINK2,FRM2311A NO 39180020 B PREWAIT PRINT MESSAGE, AND WAIT 39190020 SPACE 2 39200020 EOJ3B MVC PRWD(58),MESS2 SET UP END OF JOB MESSAGE 39210020 LA REG1,58 39220020 MVI EOJSWTCH,X'00' SET SWITCH; TELL EOJ 39230020 BAL RLINK1,PRNT 39240020 B WAITZ CHECK IF SYSOUT IS TAPE 39250020 SPACE 2 39260020 EOJ2 ST RTRKADR1,CCHH1 RE SET ADDRESS 39270020 L RTRKADR1,TOTLTRK FORCE END OF DISK 39280020 MVI EOJSWTCH,X'01' SET EOJ SWITCH 39290020 L RWRKREG4,REELCTRL SET DISK TO LAST PACK 39300020 LCR RWRKREG4,RWRKREG4 39310020 ST RWRKREG4,REELCTRL 39320020 BR RLINK2 RETURN TO WRITE TRAILER RECORD 39330020 SPACE 1 39340020 UNIT UNPK UNITHLD(5),2(3,RWRKREG4) GET AND UNPACK UNIT ADDRESS 39350020 TR UNITHLD(4),IOTAB-240 CONVERT TO PRINTABLE FORMAT 39360020 MVC MESS5+31(3),UNITHLD+1 MOVE INTO MESSAGE 39370020 MVC PRWD(59),MESS5 SET UP PRINT BUFFER 39380020 LA GR1,59 MESSAGE LENGTH 39390020 BR RLINK1 PRINT IT 39400020 EJECT 39410020 SPACE 1 39420020 DISKEOF L RWRKREG4,64 GET ADDRESS OF CCW 39430020 S RWRKREG4,EIGHT HAVE EOF. 39440020 SPACE 1 39450020 CLI 0(RWRKREG4),X'16' WAS "EOF" CAUSED BY READ R-0 39460020 BC 8,INDEXRTN YES,RETURN 39470020 SPACE 1 39480020 DISKEOF1 MVI 0(RWRKREG4),X'12' CHANGE EOF CCW TO READ COUNT. 39490020 L GR3,4(UCBREG) GET TO CORRECT CCW. 39500020 MVI DSKEOFSW,X'FF' TURN ON DISK EOF SWITCH 5434 39510020 MVI ERRETRY,X'FF' HANDLE AS IF ERROR 5196 39520020 BAL RLINK1,STARTIO GO TO EXECUTE CCW LIST. 5434 39530020 B INDEXRTN ERROR RECOVERY RETURN 5434 39540020 SPACE 1 39550020 SPACE 2 39560020 TAPEEOF TM CKVOLSW,X'41' WAS EOF ON SCRATCH 2324 39570020 BO TOTAPE1B YES, STANDARD LBL OR LDR 2324 39580020 BM TOTAPE1A YES, NONLABEL, SET MODE 2324 39590020 TM CKVOLSW,X'02' WAS EOF ON "RESTORED FROM" 39600020 BO RTRNTM YES 39610020 CL RUCBPTR,AUCBTO END OF FILE ON READ OR WRITE 39620020 BE ENDREEL WRITE 39630020 CL RUCBPTR,INPUTR WAS THE UNIT EXCPTN ON SYSIN 9930 39640020 BE ABSEQPRT IF SO, GO PRNT CNTRL SEQ ERR 9930 39650020 SPACE 1 39660020 MVC PRWD(58),MESS2 PREPARE MESSAGE OF END OF JOB 39670020 LA REG1,58 39680020 LA RLINK2,WAITZ PREPARE OF END OF JOB 39690020 LA RCAW,XRDTRLR GET REEL CONTROL RECORD 3479 39700020 L GR9,DTALENG1 LOAD ADDRESS OF BUFFER A53319 39700421 CLI 16(GR9),X'07' TRAILER RECORD ? A53319 39702021 MVC SAVEVTOC(24),0(GR9) MOVE TRAILER RECORD A53319 39704021 BNE TRAILER YES -TRAILER ALREADY READ A53319 39706021 BAL RLINK1,STARTIO 39710020 SPACE 1 39720020 TRAILER LA RWRKREG1,EOJA SET GO TO ADDRESS 39730021 OC REELCK(4),SAVEVTOC UPDATE REEL CONTROL CHECK AREA. 39740020 CLC REELCK(4),REELMASK IS JOB FINISHED 39750020 BE EOJAA 39760020 SPACE 1 39770020 LA RLINK2,FRMTAPE1 NO, PREPARE FOR NEXT ROUND 39780020 LA RCAW,XREWCCW REWIND THE TAPE 39790020 BAL RLINK1,STARTIO 39800020 SPACE 1 39810020 PREWAIT1 LA GR7,UCBFRM ADDRESS OF FROM DEVICE UCB 39820020 BAL LINK15,UNITADDR CONVERT HEX UNIT ADDR TO BCD. 39830020 L GR1,HUNIT GET ADDRESS OF UNITBUF+1. 39840020 MVC MESS1+36(3),0(GR1) PUT UNIT INTERFACE ADDR. IN MESS 39850020 MVC PRWD(65),MESS1 PUT TAPE MOUNT MESSAGE IN PRWD. 39860020 LA GR1,65 LENGTH OF MESSAGE IN BYTES. 39870020 PREWAIT BAL RLINK1,PRNT GIVE ON MESSAGE DEVICE. 39880020 PREWAITA LA RWRKREG4,FIXEX ADDRESS OF RETURN POINT. 39890020 ST RWRKREG4,CONTINUE+4 SET UP THE PSW. 39900020 LPSW COWAIT1 WAIT FOR EXTERNAL INTERRUPT. 39910020 FIXEX BR RLINK2 START NEW LOOP. 39920020 EJECT 39930020 * DUMMY AND SPECIAL CCWS 39940020 SPACE 2 39950020 DS 0D 39960020 LIMITCCW CCW X'1D',DTABUFF-8,X'20',40 39970020 LMITCCW1 CCW X'1E',DTABUFF-8,X'20',40 39980020 SPACE 1 39990020 DMYWTDK CCW X'1D',DTALENG-8,X'60',40 WRITE R1 ON 2311 IN DUMP 40000020 SPACE 1 40010020 CCW X'1D',CNTFIELD,X'A0',8 WRITE R1 ON 2311 40020020 CCW X'1D',DTABUFF,X'60',32 WRITE R1 ON 2311 40030020 SPACE 1 40040020 CCW X'31',CNTADR1+2,X'60',5 40050020 CCW 8,RDBKCK1,X'60',1 40060020 DMYRDDK CCW X'1E',DTALENG-8,X'60',X'FFFF' READ R0 FRM 2311 IN RESTR 40070020 SPACE 1 40080020 CCW X'1E',CNTFIELD,X'A0',8 40090020 CCW X'1E',DTABUFF,X'20',X'FFFF' ERAD R2 IN RESTR 40100020 SPACE 1 40110020 SEARCHID CCW 7,BBCCHH,X'60',6 SEEK TRACK 0 OR ITS ALTERNATE. 40120020 SEARCH CCW X'31',CCHHR,X'60',5 SEARCH FOR R2 OR R3. 40130020 CCW 8,SEARCH,0,0 REPEAT UNTIL FOUND. 40140020 WRTRDID CCW 6,SAVEVTOC,X'20',144 READ IPL BOOTSTRAP OR VOL.LABEL 40150020 SPACE 1 40160020 DUMMYCCW CCW X'92',CTBUFFER,X'60',8 SET UP READ COUNT 40170020 SPACE 1 40180020 DMMYRCCW CCW X'1E',DTABUFF+8,X'60',1 SET UP READ CKD 40190020 SPACE 1 40200020 TICNOP CCW 8,WTRDCCW,X'60',5 40210020 SPACE 1 40220020 DATAR0 CCW 6,R0DATA,X'60',8 READ R0 DATA. 40230020 SPACE 1 40240020 SETMODE1 CCW X'93',DTALENG,X'60',1 SET 800BPI; CNV-ON; TR-FF 40250020 WRTTPCCW CCW 1,DTALENG,X'20',1 WRITE DISK CCW LIST ON TAPE 40260020 SPACE 1 40270020 SETMODE2 CCW X'93',DTABUFF,X'60',1 SET 800BPI; CNV-ON; TR-OFF 40280020 WRTTPDTA CCW 1,DTABUFF,X'20',1 WRITE DATA (GOTTEN FROM DASD) 40290020 SPACE 1 40300020 SETMODE3 CCW X'93',DTALENG,X'60',1 SET 800BPI; CNV-ON; TR-OFF 40310020 RDTPCCW CCW 2,DTALENG,X'20',X'7FFF' READS CCW RECORD FROM TAPE. 5434 40320020 SPACE 1 40330020 SETMODE4 CCW X'93',DTABUFF,X'60',1 SET 800BPI; CNV-ON; TR-OFF 40340020 RDTPDTA CCW 2,DTABUFF,X'20',X'7FFF' READS DATA RECORD FROM TAPE.5434 40350020 SPACE 1 40360020 SETMODE5 CCW X'93',DTALENG,X'60',1 MODE SET//800 BPI,CNV-ON,TR-OFF. 40370020 CCW 1,HAR0CCW-16,X'20',88 WRITE SPECIAL CCW LIST. 5434 40380020 SPACE 1 40390020 XRDVOLID CCW X'93',SAVEVTOC,X'60',80 SET 800BPI; CNV-ON; TR-OFF 40400020 CCW 2,SAVEVTOC,X'20',80 READ VOLUME LABEL 40410020 XRDTRLR CCW X'93',SAVEVTOC,X'60',80 SET 800 BPI CNV-ON TR-OFF 3479 40420020 CCW 2,SAVEVTOC,X'20',80 READ TRAILER RECORD 3479 40430020 SPACE 1 40440020 READR0CT CCW X'16',SWITCHRD,X'20',8 READ R0 COUNT-ALTERNATE TRACK. 40450020 SPACE 1 40460020 WTMCCW CCW X'93',DTABUFF,X'60',1 SET MODE 2324 40470020 CCW X'1F',0,X'60',1 WRITE TAPE MARK 2324 40480020 CCW 3,0,X'20',1 NOP. 40490020 XREWCCW CCW 7,0,X'20',1 REWIND 40500020 EJECT 40510020 SEEK1CCW CCW 7,CNTADR1,X'60',6 THIS CCW LIST IS TO READ OR 40520020 SPACE 1 40530020 SETMASK1 CCW X'1F',FILEMASK,X'60',1 WRITE FROM 2311 IN THE 40540020 SPACE 1 40550020 SEARCCW1 CCW X'31',CNTADR1+2,X'60',5 DUMP/RESTORE - DASD - 2311 40560020 SPACE 1 40570020 SEARTIC1 CCW 8,SEARCCW1,X'60',150 40580020 SPACE 1 40590020 WRDSKCCW DS D 40600020 WDSKCCW1 DS D 40610020 WDSKCCW2 DS D 40620020 SPACE 1 40630020 RDBKCK1 CCW X'31',CNTADR1+2,X'60',5 40640020 CCW 8,RDBKCK1,X'60',1 40650020 RCCWRBC1 DS D 40660020 RCCWRBC2 DS D 40670020 RCCWRBC3 DS D 40680020 SENSETAP CCW 4,TAPEBUFS,X'20',6 SENSE COMMAND USED TO TEST TAPE. 40690020 TAPEBUFS DS D BUFFER FOR SENSE BYTES. 40700020 DTALENG1 DC X'02008000' CCW BUFFER ADDRESS. 40710020 DTABUFF1 DC X'02008800' DATA BUFFER ADDRESS. SA58009 40720021 ONLY32KA DC A(ONLY32K) RETURN ON PROGRAM INTERRUPT. 40730020 SW64K DC X'00' 'FF' INDICATES 64K OR MORE. 40740020 MODE4793 DC X'93' 7 TRACK SETS 800BPI/CONVERTER ON 40750020 MODE49C3 DC X'C3' 9 TRACK 1600 BPI IF AVAILABLE 40760020 TAPESENS DC X'00' SWITCH SET TO 0F IF TAPE TESTING 40770020 EJECT 40780020 MESS1 DC C'IBC161A END OF TAPE. MOUNT TAPE ON .' 40790020 DC C' DEPRESS INTERRUPT KEY. ' 40800020 SPACE 1 40810020 MESS2 DC C'IBC163A END OF JOB. ' 40820020 DC C' ' 40830020 SPACE 1 40840020 MESS3 DC C'IBC165A ATTEMPT RESTORE TO WRONG DEVICE - JOB' 40850020 DC C' TERMINATED ' 40860020 SPACE 1 40870020 MESS5 DC C'IBC162A MOUNT ANOTHER PACK ON .' 40880020 DC C' DEPRESS INTERRUPT KEY.' 40890020 SPACE 1 40900020 MESS7 DC C'IBC106A THE VOLID IN CONTROL STATEMENT ' 40910020 DC C'DOES NOT AGREE WITH ID IN VOL LABEL ' 40920020 DC C'WHICH FOLLOWS' 40930020 SPACE 1 40940020 BAD DC C'IBC110I BAD TRACK ' 40950020 SPACE 1 40960020 ALT DC C'IBC111I ALTERNATE ' 40970020 ALTMSG DC C'IBC168I TRACK 0 HAS AN ALTERNATE ASSIGNED THIS' 8348 40980020 DC C'VOLUME HAS BECOME NON-IPL-ABLE' 8348 40990020 SPACE 1 41000020 DSKEOFSW DC X'00' 41010020 TSWITCH DC X'00' ON IF TAPE IN OR OUTPUT S20201 41020020 SPACE 1 41030020 EJECT 41040020 * **************** 41050020 * * DASD CONTROL * 41060020 * **************** 41070020 SPACE 1 41080020 * THIS SECTION GIVES THE PROGRAM PERTINENT INFORMATION 41090020 * CONCERNING THE TO-DEVICE AND FROM DEVICE, SUCH AS MAXIMUM 41100020 * NUMBER OF RECORDS/TRACK ETC. 41110020 * THE DATA IS STORED IN THIS SECTION DURING HOUSEKEEPING. 41120020 SPACE 1 41130020 * THE CONTROL SECTION THAT MAKES THE GENERAL PART OF THE 41140020 * ROUTINE DASD INDEPENDENT. 41150020 SPACE 2 41160020 FRMDCTRL DS 0D SPACE RESERVED FOR FRMDEV CNTRL 41170020 SPACE 2 41180020 CYLINCRF DS F INCREMENTING FACTOR TO CHANGE 41190020 * CYLINDERS 41200020 UPPRLMT1 DS F UPPER LIMIT (ORIGINAL) 41210020 SPACE 1 41220020 XSTARTR DS F ADDRESS OF PRE RLINK2 41230020 SPACE 1 41240020 TRKPCYLF DS H (NUMBER OF TRACKS -1)/CYLINDER 41250020 SPACE 1 41260020 MNCCWX8F DS H (MAX NUMBER OF CCWS -1)X8 BYTES 41270020 SPACE 3 41280020 TODCTRL DS 0D SPACE RESERVED FOR TODEV CONTRL 41290020 SPACE 2 41300020 CYLINCRT DS F INCREMENTING FACTOR TO CHANGE 41310020 * CYLINDERS 41320020 DS F 41330020 SPACE 1 41340020 XSTARTD DS F ADDRESS OF PRE RLINK2 41350020 SPACE 1 41360020 TRKPCYLT DS H (NUMBER OF TRACKS -1)/CYLINDER 41370020 SPACE 1 41380020 MNCCWX8T DS H 41390020 EJECT 41400020 SPACE 1 41410020 SPACE 1 41420020 SPACE 1 41430020 ORG0600X EQU * 5274 41440020 ORG ENTER+12710 5274 41450020 ORG0700 EQU * 5274 41460020 FILEMASK DC X'D8' INHIBIT SEEK ON R COUNT 41470020 TAPESW DC X'00' TELL IF RSTR FRM TAPE OR 2311 41480020 SPACE 1 41490020 ALTSW DC X'00' FINISHED READ/WRITE ALTERNATE 41500020 SPACE 1 41510020 SPACE 1 41520020 WLRECSW DC X'00' SWITCH TO SURPRESS WRONG LENGTH 41530020 SPACE 1 41540020 VOL1 DC C'VOL1' COMPARE FACTOR - FOR LABEL 41550020 SPACE 1 41560020 VOLIDIS DC C'VOLID=' 41570020 SPACE 1 41580020 CKVOLSW DC X'00' TAPE MARK ENCOUNTERED 41590020 SPACE 1 41600020 PRTKCODE DC X'F47006016663B24D' 41610020 PRTKCOD1 DC X'F4701D16FB63B24D' 2311 HEADER LABEL CODE. 41620020 EOJSWTCH DC X'00' 41630020 SPACE 1 41640020 NOISECK DC X'0018' IS IT NOISE RECORD 41650020 A1 DC AL3(ADDRSCH1) 41660020 A2 DC AL3(ADDRSCH2) 41670020 ADCTBUFF DC A(CTBUFFER) BUFFER ADDRESS FOR COUNT FIELDS 41680020 CON32K DC F'32768' 41690020 CON40K DC F'40960' 41700020 TWO56 DC X'00000100' 5434 41710020 ASEARIDE DC A(SEARIDE) 5434 41720020 SIXTEENX DC X'00000010' 5434 41730020 REELCK DC X'00000000' CHECK IF 1ST REEL ON TAPE. 5434 41740020 REELCTRL DC X'00000001' MODIFIES REEL CONTRL RECORD. 5434 41750020 REELMASK DC X'FFFFFFFE' CHECK IF LAST REEL ON TAPE. 5434 41760020 AUCBTO DC A(UCBTO) TO-DEVICE UCB ADDRESS. 5434 41770020 EJECT 41780020 SPACE 1 41790020 SPACE 1 41800020 UNITHLD DC D'0' BUFFER FOR CONVERTING UNIT ADD. 41810020 SPACE 1 41820020 CCHHR DC X'0000000003' ADDRESS OF VOLUME LABEL 41830020 SPACE 1 41840020 USEDLABL DC X'012954367815' 41850020 DASDIDR DC C'DASDI - DUMP/RESTORE' 41860020 SPACE 1 41870020 * SEEK ETC AND SPACE SAVED FOR READ COUNT CCWS 41880020 SPACE 2 41890020 SPACE 2 41900020 SEEKALT CCW 7,BBCCHH,X'60',6 CCW LIST USED TO READ 41910020 CCW X'1A',ALTBUFF,X'60',5 HOME ADDRESS AND 41920020 CCW X'16',ALTBUFF+5,X'20',8 R0 OF BAD TRACK 41930020 SPACE 1 41940020 ALTCCW CCW 7,CCHHALT-2,X'60',6 SEEK ACTUAL ALT 41950020 CCW 8,SETMASK,X'60',5 41960020 SPACE 1 41970020 DS 0D 41980020 DC XL4'00' 41990020 CCHHALT DC XL4'00' 42000020 SPACE 2 42010020 DC D'0' USED BY CCHHALT AND CNTADR1 42020020 DC H'0' 42030020 CNTADR1 DC 3H'0' 42040020 DC D'0' 42050020 CNTFIELD DS 0D 42060020 CCHH1 DC H'0' 42070020 HH1 DC H'0' 42080020 DC F'0' 42090020 REGPSW DC A(PGMINT) 42100020 CON64KK DC F'65008' 42110020 NEWTRK DC 6X'00' SEEK ADDRESS FOR ALTERNATE TRACK 42120020 GOTOALT CCW X'07',NEWTRK,X'40',6 SEEK TO ALTERNATE 42130020 CCW X'08',SEARCCW1,0,0 TIC TO SEARCH IN REGULAR CHAIN 42140020 CCHHZERO DC F'0' CONTAINS CCHH OF VOL.LABELTRK. 42150020 EIGHT DC F'08' FULLWORD OF 08. 42160020 SPACE 1 42170020 EJECT 42180020 ORG0700X EQU * 5274 42190020 ORG ENTER+12970 5274 42200020 ORG0800 EQU * 5274 42210020 BBCCHH DC X'0000' 42220020 CCHH DC X'0000' 42230020 HH DC X'0000' 42240020 R DC F'0' 42250020 SPACE 1 42260020 ORG0800X EQU * 5274 42270020 ORG ENTER+12984 5274 42280020 ORG0900 EQU * 5274 42290020 DTALENG DC XL16'00' 42300020 SEEKCCW CCW 7,BBCCHH,X'60',6 42310020 SPACE 1 42320020 SETMASK CCW X'1F',FILEMASK,X'60',1 42330020 SPACE 1 42340020 SEARIDE CCW X'31',CCHH,X'60',5 SEARCH R0 ID EQUAL 42350020 SPACE 1 42360020 CCW 8,SEARIDE,X'60',5 TIC BACK 42370020 SPACE 1 42380020 WTRDDATA CCW 6,R0DATA,X'60',8 READ R0 DATA. 42390020 SPACE 1 42400020 WTRDCCW DS 160D 42410020 DS 160D 42420020 WTRDCCW2 EQU WTRDCCW+1840 CCW LIST FOR READ CT/KEY/DATA. 42430020 SAVEVTOC DS 18D BUFFER TO SAVE VTOC 42440020 SPACE 42450020 ALTBUFF EQU SAVEVTOC+50 42460020 SPACE 42470020 * THESE CCWS MUST BE PLACED AT LEAST AT 3D30 TO AVOID BEING 42480020 * OVERLAYED BY SCAN ROUTINE 42490020 SPACE 42500020 HAR0CCW CCW 7,BBCCHH,X'40',6 SEEK 42510020 CCW X'1F',FILEMASK,X'40',1 SET FILE MASK. 42520020 ADDRSCH1 CCW X'31',CCHH,X'60',5 SEARCH FOR R0 42530020 CCW 8,13016,0,0 REPEAT UNTIL FOUND. 42540020 WTRDR0 CCW 5,DTABUFF,X'60',8 WRITE OR READ R0 S20201 42550020 ADDRSCH2 CCW X'31',CCHH,X'60',5 SEARCH FOR R0 42560020 CCW 8,13040,0,0 REPEAT UNTIL FOUND. 42570020 CCW 6,DTABUFF,X'70',8 READ BACK CHECK R0 DATA. 42580020 CCW X'11',CLEAR,X'20',8 ERASE REST OF TRACK. 42590020 SPACE 2 42600020 * BUFFERS USED FOR COUNTS AND DATA FROM DISK 42610020 ORG0900X EQU * 5274 42620020 ORG ENTER+15888 5274 42630020 ORG1000 EQU * 5274 42640020 SPACE 2 42650020 DC X'000000010100' 42660020 DC X'0020' 42670020 DTABUFF DS 10D * S20201 42680020 OPRTAB DC C'JOB ' S20201 42690020 B JOBANL SCAN JOB CARD STATEMENT S20201 42700020 DC C'MSG ' MESSAGE KEYWORD S20201 42710020 B MODANL CHECK MSG DEVICE S20201 42720020 DC C'DUMP ' DUMP KEYWORD S20201 42730020 B DUMPANL SET DUMP SWITCH S20201 42740020 DC C'RESTORE ' RESTORE KEYWORD S20201 42750020 B RSTRANL SET RESTORE SWITCH S20201 42760020 DC C'VDRL ' VDRL KEYWORD S20201 42770020 B VDRLANL SCAN BEGIN ADDR S20201 42780020 DC C'END ' END ADDR KEYWORD S20201 42790020 B ENDANL CHECK END ADDRESS S20201 42800020 KEYTAB DC C'FROMDEV ' FROMDEV KEYWORD S20201 42810020 B SVFRMDL FROM DEVICE S20201 42820020 DC C'FROMADDR' FROMADDR KEYWORD S20201 42830020 B SVFRMDEV FROM ADDRESS S20201 42840020 DC C'TODEV ' TO DEVICE KEYWORD S20201 42850020 B SVTOMDL TO DEVICE S20201 42860020 DC C'TOADDR ' TOADDR KEYWORD S20201 42870020 B SVTODEV TO ADDRESS S20201 42880020 DC C'VOLID ' VOLID KEYWORD S20201 42890020 B SVVOLID CHECK VOLID S20201 42900020 DC C'BEGIN ' BEGIN KEYWORD S20201 42910020 B SVBEGIN BEGIN ADDRESS S20201 42920020 DC C'BIN ' BIN KEYWORD S20201 42930020 B SETBINAD BIN NUMBER S20201 42940020 DC C'MODE ' MODE KEYWORD S20201 42950020 B SETMODE TAPE MODE S20201 42960020 DC C'MODEL ' MODEL KEYWORD S20201 42970020 B SVMOD MODEL FOR 2305 S20201 42980020 DC C'END ' END KEYWORD S20201 42990020 B SVEND END OF CARDS S20201 43000020 SYINTAB DC C'1402' DEVICE TYPE S20201 43010020 DC X'18' DEVICE CODE S20201 43020020 DC C'2540' DEVICE TYPE S20201 43030020 DC X'18' DEVICE CODE S20201 43040020 DC C'1442' DEVICE TYPE S20201 43050020 DC X'19' DEVICE CODE S20201 43060020 DC C'2501' DEVICE TYPE M5715 43062020 DC X'19' DEVICE CODE M5715 43064020 DC C'2520' DEVICE TYPE M5715 43066020 DC X'19' DEVICE CODE M5715 43068020 MODTABL DC C'2400' DEVICE TYPE S20201 43070000 DC X'08' DEVICE CODE S20201 43080020 DC C'2420' DEVICE TYPE S20201 43090020 DC X'08' DEVICE CODE S20201 43100020 DC C'3410' DEVICE TYPE M1828 43102000 DC X'08' DEVICE CODE M1828 43102400 DC C'3420' DEVICE TYPE M1828 43104000 DC X'08' DEVICE CODE M1828 43106000 MODTAB DC C'1403' DEVICE TYPE S20201 43110020 DC X'1A' DEVICE CODE S20201 43120020 DC C'3211' DEVICE TYPE S20201 43130020 DC X'1A' DEVICE CODE S20201 43140020 DC C'1443' DEVICE TYPE S20201 43150020 DC X'1B' DEVICE CODE S20201 43160020 DC C'1052' DEVICE TYPE S20201 43170020 DC X'17' DEVICE CODE S20201 43180020 DC C'3210' DEVICE TYPE S20201 43190020 DC X'17' DEVICE CODE S20201 43200020 DC C'3215' DEVICE TYPE MS0022 43202000 DC X'17' DEVICE CODE MS0022 43204000 DEVTAB DC C'2321' DEVICE TYPE S20201 43250020 DC X'00' DEVICE CODE S20201 43260020 DC C'2302' DEVICE TYPE S20201 43310020 DC X'03' DEVICE CODE S20201 43320020 DC C'2303' DEVICE TYPE S20201 43330020 DC X'04' DEVICE CODE S20201 43340020 DC C'2301' DEVICE TYPE S20201 43350020 DC X'05' DEVICE CODE S20201 43360020 DC C'2305' DEVICE TYPE S20201 43370020 DC X'06' DEVICE CODE S20201 43380020 DEVTABL DC C'2311' DEVICE TYPE S20201 43382000 DC X'01' DEVICE CODE S20201 43384000 DC C'2314' DEVICE TYPE S20201 43386000 DC X'02' DEVICE CODE S20201 43388000 DC C'3330' DEVICE TYPE S20201 43390020 DC X'09' DEVICE CODE S20201 43400020 DEVTAB1 DC C'2400' DEVICE TYPE S20201 43430020 DC X'08' DEVICE CODE S20201 43440020 DC C'2420' DEVICE TYPE S20201 43450020 DC X'08' DEVICE CODE S20201 43460020 DC C'3410' DEVICE TYPE M1828 43462000 DC X'08' DEVICE CODE M1828 43464000 DC C'3420' DEVICE TYPE M1828 43466000 DC X'08' DEVICE CODE M1828 43468000 TABEND DS 0F * S20201 43530020 EJECT 43540020 ORG1000X EQU * 5274 43550020 ORG WTRDCCW 5274 43560020 ORG1100 EQU * 5274 43570020 * *********************************************** 43580020 * * CTL STATEMENT ANALYSIS ROUTINES * 43590020 * *********************************************** 43600020 CLRSCAN XC SWITCHRD(116),SWITCHRD CLEAR SCAN WORK AREA. 43610020 MVI SEQSW,X'00' CLEAR SEQSW 43620020 XC CONTAB(32),CONTAB CLEAR CONDENSED CTL INFORMATION 43630020 TOSCAN L BASE12,SYSBASE ESTABLISH SCAN ROUTINE BASE REG 43640020 BAL 14,RDCARD LINK TO CTL CARD SCAN ROUTINE 43650020 SCANANL TM SWITCHRD,X'80' IS SCAN ERROR BIT ON 43660020 BO SCANERR YES-CONTOL STATEMENT ERROR. 43670020 TM SWITCHRD,X'40' SCAN 43680020 BZ TEST3 BRANCH IF OFF 43690020 LTR LENGTH,LENGTH SCAN LENGTH REG ZERO 43700020 BE SCANERR YES-CONTROL STATEMENT ERROR. 43710020 TEST3 TM SWITCHRD,X'08' IS THIS A COMMAND 43720020 BC 1,CTLPRNT GO TO CTL STATEMENT PRINT 43730020 TM SWITCHRD,X'04' IS THIS A KEYWORD 43740020 BC 1,KEYLUP YES - PERFORM KEYWORD LOOKUP 43750020 B SCANERR SCAN ERROR 43760020 CTLPRNT TM SEQSW,X'02' IS SYSOUT DEFINED 43770020 BC 14,OPRLUP PERFORM COMMAND LLOKUP. 43780020 CLI JOBSW,X'FF' YES - HAS JOB STM BEEN PRINTED 43790020 BC 7,OPRLUP YES-BYPASS INITIAL PRINT ROUTINE 43800020 STM SCANADR,LENGTH,REGSV1 SAVE SCAN REGS 43810020 MVC PRWD+20(18),OPRMSG+29 SET PRINT DUMP/RESTORE HDR 6379 43820020 LA GR1,38 LENGTH OF MESSAGE IN BYTES. 43830020 BAL LINK9,PRNT PRINT HEADER MESSAGE. 43840020 MVC PRWD(80),DTABUFF NO - PRINT JOB STATEMENT 43850020 BAL LINK9,WASH CALL THE PRINT ROUTINE SA58009 43870021 MVC PRWD(80),MODSAV PRINT MOD STATEMENT 43880021 BAL LINK9,WASH CALL THE PRINT ROUTINE SA58009 43890021 MVI JOBSW,X'00' CLEAR JOBSW 43900020 LM SCANADR,LENGTH,REGSV1 RESTORE SCAN REGISTERS 43910020 * 43920020 * OPERATOR LOOKUP ROUTINE 43930020 * 43940020 OPRLUP LA CSR3,OPRTAB START OF COMMAND TABLE 43950020 LA CSR5,KEYTAB-12 END OF OPRTAB 43960020 SCANTBL STC LENGTH,SAVLGTH SAVE LENGTH REGISTER FROM SCAN 43970020 CLI SAVLGTH,8 IS LENGTH 8 OR LESS. 43980020 BH SCANERR NO- LENGTH EXCEEDS 8 43990020 LA GR4,12 INCREMENTING FACTOR 44000020 MVI SARG,C' ' CLEAR SEARCH ARGUMENT 44010020 MVC SARG+1(7),SARG 44020020 BCTR LENGTH,0 44030020 EX LENGTH,OPRLUP3 MOVE SCAN OPERATOR TO 44040020 OPRCMP CLC SARG(8),0(CSR3) SARG 44050020 BNE OPRLUP2 FIND 44060020 LA CSR3,8(0,CSR3) SET UP BRANCH IF YES 44070020 BR CSR3 ENTER PROPER ROUTINE 44080020 OPRLUP2 BXLE CSR3,CSR4,OPRCMP LOOP TO CONTINUE SEARCH 44090020 B SCANERR INVALID OPERATOR 44100020 OPRLUP3 MVC SARG(1),0(SCANADR) MOVE SCANADR TO SEARCH ARGUMENT 44110020 * 44120020 * KEYWORD LOOKUP ROUTINE 44130020 * 44140020 KEYLUP LA CSR3,KEYTAB START OF KEY TABLE 44150020 LA CSR5,SYINTAB-12 END OF KEY TABLE 44160020 B SCANTBL SEARCH FOR KEY WORD 44170020 * 44180020 JOBANL MVC DTABUFF(80),SWITCHRD+1 SAVE JOB STATEMENT 44190020 OI SEQSW,X'01' SET SEQUENCE SWITCH 44200020 OI SWITCHRD,X'40' SET BYPASS SW ON 44210020 B TOSCAN RETURN TO SCAN 44220020 * 44230020 MODANL MVC MODSAV(80),SWITCHRD+1 SAVE MOD STATEMENT 44240020 TM SEQSW,X'01' CHECK STATEMENT SEQUENCE 44250020 BC 14,ABSEQERR SEQUENCE ERROR ROUTINE 44260020 OI SEQSW,X'02' SET SEQUENCE SWITCH 44270020 B TOSCAN RETURN TO SCAN 44280020 * 44290020 DUMPANL TM SEQSW,X'03' CHECK STATEMENT SEQUENCE 44300020 BC 14,ABSEQERR SEQUENCE ERROR 44310020 TM SEQSW,X'04' DUMP STM PREVIOUSLY RECEIVED 44320020 BC 1,ABSEQERR YES - SEQUENCE ERROR 44330020 TM SEQSW,X'08' RESTORE STM PREVIOUSLY RECEIVED 44340020 BC 1,ABSEQERR YES - SEQUENCE ERROR 44350020 OI SEQSW,X'04' SET SEQUENCE SWITCH 44360020 MVI PRNTSW,X'01' SET TO PRINT STATEMENT. 44370020 B TOSCAN RETURN TO SCAN 44380020 * 44390020 RSTRANL TM SEQSW,X'07' CHECK STATEMENT SEQUENCE 44400020 BC 1,ABSEQERR 44410020 TM SEQSW,X'03' CHECK SEQUENCE 44420020 BC 14,ABSEQERR SEQUENCE ERROR 44430020 OI SEQSW,X'08' SET RESTORE BIT IN SEQSW 44440020 MVI PRNTSW,X'01' SET TO PRINT STATEMENT. 44450020 B TOSCAN RETURN TO SCAN 44460020 * 44470020 VDRLANL TM SEQSW,X'07' CHECK STATEMENT SEQUENCE 44480020 BC 1,VSRLANL1 44490020 TM SEQSW,X'0B' 44500020 BO ABSEQERR SEQUENCE ERROR S20201 44510020 VSRLANL1 OI SEQSW,X'10' SET SEQUENCE SW 44520020 MVI PRNTSW,X'01' SET TO PRINT STATEMENT. 44530020 B TOSCAN RETURN TO SCAN 44540020 * 44550020 ENDANL MVC PRWD(80),CARDBUFF MOVE END CARD TO PRINT BUFFER. 44560020 BAL LINK9,WASH PRINT THE END CARD. SA58009 44580021 TM SEQSW,X'07' CHECK STATEMENT SEQUENCE. 44590020 BC 1,ENDANL1 44600020 TM SEQSW,X'0B' SEQUENCE CHECKING 44610020 BC 1,ENDANL1 44620020 TM SEQSW,X'17' SEQUENCE CHECKING 44630020 BC 1,ENDANL1 44640020 TM SEQSW,X'1B' SEQUENCE CHECKING 44650020 BC 14,ABSEQERR SEQUENCE ERROR 44660020 ENDANL1 B SETUP2 44670020 * 44680020 SVMODEL BAL LINK5,GETPARM GET PARAMETER 44690020 MVC SYOMDL(4),0(SCANADR) SAVE MODEL NUMBER 44700020 LA CSR2,SYOMDL ESTABLISH UCBSYO 44710020 LA CSR3,MODTABL TABLE LIMITS START AND M1828 44720000 LA CSR5,DEVTAB-5 END ADR RESPECTIVELY 44730020 BAL LINK9,DEVLUP 44740020 MVC UCBSYO(1),0(CSR3) SET DEVICE TYPE CODE 44750020 B TOSCAN RETURN TO SCAN 44760020 * 44770020 SVDEV BAL LINK5,GETPARM GET PARAMETER 44780020 MVC SYODEV(3),0(SCANADR) SAVE DEVICE ADDRESS 44790020 LA CSR2,SYODEV 44800020 BAL LINK9,INTFCECK CHECK INTERFACE ADR 44810020 BC 15,SCANERR GO TO SCAN ERROR ROUTINE 44820020 STH CSR1,UCBSYO+2 SET INTERFACE ADR 44830020 B TOSCAN RETURN TO SCAN 44840020 * 44850020 SVFRMDL BAL LINK5,GETPARM GET PARAMETER 44860020 MVC FMODEL(4),0(SCANADR) SAVE FROM MODEL 44870020 B TOSCAN RETURN TO SCAN 44880020 * 44890020 SVFRMDEV BAL LINK5,GETPARM GET PARAMETER 44900020 MVC FMDEV(3),0(SCANADR) SAVE FROM DEVICE ADDRESS 44910020 B TOSCAN RETURN TO SCAN 44920020 SVTOMDL CLI SEQSW,X'03' IS THIS A MSG CTL STATEMENT 44930020 BC 8,SVMODEL YES - SAVE MSG TODEV 44940020 BAL LINK5,GETPARM GET PARAMETER 44950020 MVC TOMDL(4),0(SCANADR) SAVE TO MODEL NUMBER 44960020 B TOSCAN RETURN 44970020 * 44980020 SVTODEV CLI SEQSW,X'03' IS THIS A MSG CTL STATEMENT 44990020 BC 8,SVDEV YES - SAVE MSG TOADDR 45000020 BAL LINK5,GETPARM GET PARAMETER 45010020 MVC TODEV(3),0(SCANADR) SAVE TO DEVICE ADDRESS 45020020 B TOSCAN RETURN 45030020 SVMOD BAL LINK5,GETPARM GET PARAMETER S20201 45040020 MVC MMOD(L1),ZERR(SCANADR) SAVE MODEL S20201 45050020 B TOSCAN RETURN TO SCAN S20201 45060020 SPACE 1 45070020 SETBINAD BAL LINK5,GETPARM GET PARAMETER 45080020 MVC BBCCHH+1(1),0(SCANADR) MOVE BIN NUMBER 45090020 NI BBCCHH+1,X'0F' CLEAR ZONE BIT 45100020 MVC CCHHALT-2(2),BBCCHH PUT BIN NUMBER TO SEEK ALT. 4608 45110020 B TOSCAN RETURN 45120020 SPACE 2 45130020 GETPARM BAL 14,RDCARD SCAN FOR PARAMETER 45140020 TM SWITCHRD,X'80' IS SCAN ERROR SWITCH ON 45150020 BC 1,SCANERR YES - SCAN ERROR 45160020 TM SWITCHRD,X'02' IS THIS A PARAMETER 45170020 BC 14,SCANERR NO - SCAN ERROR CONDITION 45180020 BR LINK5 RETURN 45190020 EJECT 45200020 SVBEGIN LA GR6,BGNADR+6 GET "SAVE" ADDRESS 45210020 MVI ENDSW,X'01' SET VDRL END SWITCH 45220020 B ADDRLBL FINISH 45230020 SPACE 1 45240020 SVVOLID LA GR6,VOLLABEL+6 GET ADDRESS OF VOLID SAVE AREA 45250020 MVI ENDSW,X'30' SET FOR FIRST VOLID PARAMETER 45260020 B ADDRLBL 45270020 SPACE 1 45280020 SVEND LA GR6,ENDADRX+6 GET "SAVE" ADDRESS 45290020 MVI ENDSW,X'00' CLEAR VDRL END SWITCH 45300020 SPACE 2 45310020 ADDRLBL BAL 14,RDCARD SCAN FOR PARAMETER 45320020 TM SWITCHRD,X'80' IS SCAN ERROR SW ON 45330020 BC 1,SCANERR YES- SCAN ERROR 45340020 TM SWITCHRD,X'04' WAS THIS KEYWORD 45350020 BO KEYLUP YES 45360020 TM SWITCHRD,X'02' IS THIS A PARAMETER 45370020 BC 14,SCANERR NO - SCAN ERROR 45380020 CH LENGTH,SIXX+2 LENGTH LESS THAN OR EQUAL 6BYTES 45390020 BH SCANERR NO - SCAN ERROR 45400020 SPACE 1 45410020 TM ENDSW,X'10' VOLID 45420020 BO ADDRLBLB YES, LEFT ADJUST 45430020 SR GR6,LENGTH BEGINNING OF STORE(RIGHT ADJUST) 45440020 ADDRLBLA BCTR LENGTH,0 DECREMENT LENGTH FOR EXICUTE 45450020 EX LENGTH,MOVEA SAVE PARAMETER 45460020 LA GR6,7(LENGTH,GR6) INCRIMENT VOL ID SAVE AREA 45470020 TM ENDSW,X'30' WAS THIS VOLID PARAMETER 45480020 BZ TOSCAN NO, GET ANOTHER KEY WORD 45490020 BM ADDRLBL1 YES, BUT NOT FIRST 45500020 MVC VOLLBL1(6),VOLLABEL YES, FIRST-SO SAVE VOLID 45510020 MVI ENDSW,X'10' RESET END SWITCH 45520020 ADDRLBL1 TM SWITCHRD,X'40' WAS THIS LAST PARAMETER 45530020 BO TOSCAN YES 45540020 B RDCARD GET ANOTHER PARAMETER 45550020 SPACE 1 45560020 SETMODE BAL LINK5,GETPARM GET PARAMETER 45570020 LA GR6,2 MAXIMUM SIZE OF PARAMETER 45580020 CLR GR6,LENGTH IS LENGTH OF PARAMETER 2 BYTES 45590020 BC 7,SCANERR NO- CONTROL STATEMENT ERROR 45600020 TM SEQSW,X'0C' IS PARAMETER ON DUMP/RESTORE CD 45610020 BC 8,SCANERR NO- CONTROL STATEMENT ERROR 45620020 MVC MODESET(2),0(SCANADR) MOVE MODESET PARAMETER TO SAVE 45630020 OC MODESET(2),CTOEMASK CHANGE C ZONE TO E ZONE 45640020 TR MODESET(2),ALTTT-225 CONVERT MODESET TO HEX. 45650020 PACK MODESET+1(2),MODESET(3) REMOVE EXTRANEOUS BITS 45660020 CLI MODESET+1,X'93' TEST IF 800/CONVERTER ON 7 TRACK 45670020 BE MODEISOK YES- MODE IS GOOD 45680020 CLI MODESET+1,X'53' TEST IF 556/CONVERTER ON 7 TRACK 45690020 BE MODEISOK YES- MODE IS GOOD 45700020 CLI MODESET+1,X'13' TEST IF 200/CONVERTER ON 7 TRACK 45710020 BE MODEISOK YES- MODE IS GOOD 45720020 CLI MODESET+1,X'CB' TEST IF 800 BPI 9 TRACK 45730020 BE MODEISOK YES- MODE IS GOOD 45740020 CLI MODESET+1,X'C3' TEST IF 1600BPI 9 TRACK 45750020 BNE SCANERR NO- CONTROL STATEMENT ERROR 45760020 MODEISOK MVI MODESW,X'0F' SET MODE SWITCH 45770020 B TOSCAN RETURN TO SCAN 45780020 SPACE 1 45790020 MOVEA MVC 0(1,GR6),0(SCANADR) SAVE PARAMETER 45800020 SPACE 1 45810020 ADDRLBLB S GR6,SIXX LEFT ADJUST ; VOLID 45820020 B ADDRLBLA RETURN 45830020 SPACE 2 45840020 * DEVICE TYPE LOOKUP ROUTINE 45850020 * 45860020 * REG CSR2 CONTAINS FACTOR TO WHICH COMPARSION IS MADE 45870020 * REG CSR3 CONTAINS BEGIN ADR OF DEVICE LOOKUP TABLE 45880020 * REG CSR5 CONTAINS END ADR OF DEVICE LOOKUP TABLE 45890020 * 45900020 * REG CSR3 CONTAINS DEVICE TYPE CODE UPON RETURN TO CALLER 45910020 * 45920020 * 45930020 DEVLUP LA CSR4,5 INDEX THROUGH TABLE ENTRIES 45940020 DEVLUP1 CLC 0(4,CSR2),0(CSR3) COMPARE ADR IN CSR2 TO DEVTAB 45950020 BNE DEVLUP2 NO COMPARE 45960020 LA CSR3,4(0,CSR3) RETURN CSR3 = DEVICE TYPE CODE 45970020 BR LINK9 45980020 DEVLUP2 BXLE CSR3,CSR4,DEVLUP1 CONTINUE SEARCH 45990020 B SCANERR ** ERROR 46000020 * 46010020 * CHANNEL CHECK AND CONVERSION ROUTINE 46020020 * 46030020 * REG CSR2 CONTAINS THE CHANNEL AND UNIT ON ENTRY 46040020 * REG CSR1 CONTAINS CONVERTED C/U UPON EXIT 46050020 * 46060020 * 46070020 * CHECK UNIT ADDRESS 46080020 * 46090020 INTFCECK LA CSR3,3 SET COUNTER FOR 3 DIGITS M6370 46100020 INTFCE1 TM 0(CSR2),X'F0' IS DIGIT A NUMBER 46120020 BC 1,INTFCE2 YES 46130020 CLI 0(CSR2),C'A' IS DIGIT A HEX DIGIT 46140020 BC 4,0(0,LINK9) NO - ERROR RETURN TO CALLER 46150020 CLI 0(CSR2),C'F' DIGIT LESS THAN HEX F 46160020 BC 2,0(0,LINK9) NO - ERROR RETURN TO CALLER 46170020 TR 0(1,CSR2),ALTTT-X'C1' CONVERT A THRU F 6379 46180020 OI 0(CSR2),X'F0' MAKE A THRU F PACKABLE 6379 46190020 INTFCE2 LA CSR2,1(0,CSR2) INCREASE LOCATOR BY 1 46200020 BCT CSR3,INTFCE1 ARE BOTH U DIGITS CHECKED 46210020 SH CSR2,CON03 RESET LOCATOR TO ORIGINAL POINT 46220020 PACK UNITADR(2),0(3,CSR2) COMBINE CHANNEL AND UNIT ADR 46230020 LH CSR1,UNITADR GET PACKED DEVICE ADR 46240020 SLL CSR1,16 CLEAR HIGH ORDER BYTES M6370 46246020 SRL CSR1,20 CLEAR SIGN FROM PACKED M6370 46252020 BC 15,4(0,LINK9) NORMAL RETURN TO CALLER 46260020 UNITADR DS 2C CONVERTED DEVICE ADDRESS 46270020 CON03 DC AL2(3) CONSTANT OF 3 46280020 SPACE 2 46290020 SCANERR TM SWITCHRD,X'08' THIS ERROR OCCUR ON A COMMAND. 46300020 BC 14,SCANPRT NO--HANDLE AS PRINTED STATEMENT. 46310020 MVI PRNTSW,X'01' YES-FORCE PRINTING OF MESSAGE. 46320020 BAL LINK14,RDCARD GO TO PRINT BAD STATEMENT. 46330020 SCANPRT MVC PRWD(33),SCANMSG PRINT SCAN ERROR MESSAGE. 46340020 B ERRPRINT GO TO PRINT STATEMENT. 46350020 SPACE 1 46360020 ABSEQERR TM SWITCHRD,X'08' THIS ERROR OCCUR ON A COMMAND. 46370020 BC 14,ABSEQPRT NO--HANDLE AS PRINTED STATEMENT. 46380020 MVI PRNTSW,X'01' YES-FORCE PRINTING OF MESSAGE. 46390020 BAL LINK14,RDCARD GO TO PRINT BAD STATEMENT. 46400020 ABSEQPRT MVC PRWD(34),SEQMSG SEQUENCE ERROR MESSAGE. 46410020 ERRPRINT MVC PRWD+34(18),QUITJOB JOB TERMINATED MESSAGE. 46420020 LA GR1,52 MESSAGE SIZE. 46430020 BAL LINK9,PRNT CALL PRINT ROUTINE. 46440020 LPSW COWAIT ERROR HALT ALL E'S. 46450020 SCANMSG DC C'IBC102A CONTROL STATEMENT ERROR.' 46460020 SEQMSG DC C'IBC103A STATEMENT SEQUENCE ERROR.' 46470020 PRNTSW DC X'00' 46480020 SETUP2 LA CSR2,FMODEL 46490020 TM SEQSW,X'04' DUMP REQUEST 46500020 BC 1,ALTER1 ADJUST DEVICE LOOKUP FOR DUMP 46510020 TM SEQSW,X'08' RESTORE REQUESTED 46520020 BC 1,ALTER2 ADJUST DEVICE LOOKUP FOR RESTORE 46530020 B ABSEQERR CTL STATEMENT SEQUENCE ERROR 46540020 ALTER1 LA CSR3,DEVTAB TABLE LIMITS START ADR AND 46550020 LA CSR5,DEVTAB1-5 END ADR RESPECTIVELY M1828 46560000 B DEVCHK1 46570020 ALTER2 LA CSR3,DEVTABL TABLE LIMITS START ADR AND M1828 46580000 LA CSR5,TABEND-5 END ADR RESPECTIVELY 46590020 DEVCHK1 BAL LINK9,DEVLUP PERFORM DEVICE LOOKUP 46600020 MVC UCBFRM(1),0(CSR3) 46610020 LA CSR2,FMDEV 46620020 BAL LINK9,INTFCECK CHECK INTERFACE ADR 46630020 BC 15,SCANERR GO TO SCAN ERROR ROUTINE 46640020 STH CSR1,UCBFRM+2 46650020 SETUP3A CLI UCBFRM,T2305 CHECK FOR 2305 S20201 46660020 BNE SETUP3 BR IF NOT A 2305 S20201 46670020 CLI MMOD,MODBIT WAS MODEL SPECIFIED S20201 46680020 BE SETUP3 BYPASS MORE CHECKS S20201 46690020 CLI MMOD,ONE WAS MODEL EQUAL TO 1 S20201 46700020 BE SETUP3 BR IF YES S20201 46710020 CLI MMOD,TWO IS IT A 2305-2 S20201 46720020 BNE SCANERR BRANCH IF MODEL INVALID S20201 46730020 OI UCBFRM,ORONE MAKE INDEX FOR 2305-2 S20201 46740020 * 46750020 SETUP3 LA CSR2,TOMDL 46760020 TM SEQSW,X'04' DUMP REQUEST 46770020 BC 1,ALTER4 46780020 TM SEQSW,X'08' RESTORE REQUESTED 46790020 BC 1,ALTER3 46800020 B ABSEQERR CTL STATEMENT SEQUENCE ERROR 46810020 ALTER3 LA CSR3,DEVTAB TABLE LIMITS START ADR AND 46820020 LA CSR5,DEVTAB1-5 END ADR RESPECTIVELY M1828 46830000 B DEVCHK2 46840020 ALTER4 LA CSR3,DEVTABL TABLE LIMITS START ADR AND M1828 46850000 LA CSR5,TABEND-5 END ADR RESPECTIVELY 46860020 DEVCHK2 BAL LINK9,DEVLUP PERFORM DEVICE LOOKUP 46870020 MVC UCBTO(1),0(CSR3) 46880020 LA CSR2,TODEV 46890020 BAL LINK9,INTFCECK CHECK INTERFACE ADR 46900020 BC 15,SCANERR GO TO SCAN ERROR ROUTINE 46910020 STH CSR1,UCBTO+2 46920020 SETUP4A CLI UCBTO,T2305 IS DEVICE A 2305 S20201 46930020 BNE SETUP4 BR IF NOT A 2305 S20201 46940020 CLI MMOD,MODBIT WAS MODEL SPECIFIED S20201 46950020 BE SETUP4 BR IF NO MOD SPECIFIED S20201 46960020 CLI MMOD,ONE WAS MODEL EQUAL TO 1 S20201 46970020 BE SETUP4 BR IF MOD EQUAL 1 S20201 46980020 CLI MMOD,TWO IS IT A 2305-2 S20201 46990020 BNE SCANERR BRANCH IF MODEL INVALID S20201 47000020 OI UCBTO,ORONE MAKE INDEX FOR 2305-2 S20201 47010020 * 47020020 SETUP4 L BASE12,SYSBASE ESTABLISH UTILITY BASE REG 47030020 BAL LINK9,START1A SET UP LIMITS FOR DEVICE 47040020 TM SEQSW,X'10' IS THERE A VDRL STATEMENT 47050020 BC 14,UTLPGM ****LINKAGE POINT TO THE P/P 47060020 PACK CVBCOM(8),BGNADR(6) PACK RELATIVE BEGINNING ADDRESS 47070020 CVB CSR1,CVBCOM CONVERT GEGIN ADR TO BINARY 47080020 ST CSR1,BGNADR STORE CONVERTED BEGIN ADR 47090020 XC CVBCOM(6),CVBCOM CLEAR CVBOM 47100020 TM ENDSW,X'01' VDRL END VALUE GIVEN 47110020 BO SKIPEND NO 47120020 PACK CVBCOM(8),ENDADRX(6) PACK RELATIVE END ADDRESS 47130020 CVB CSR1,CVBCOM CONVERT END ADR TO BINARY 47140020 ST CSR1,ENDADR STORE CONVERTED END ADR 47150020 SKIPEND XC CVBCOM(6),CVBCOM CLEAR CVBCOM 47160020 CLC ENDADR(4),BGNADR IS BGNADR > ENDADR 47170020 BC 4,SCANERR YES - CTL STATEMENT ERROR 47180020 SPACE 2 47190020 * ROUTINE CONVERTS RELATIVE TRACK ADDRESS TO ACTUAL ADDRESS 47200020 * 47210020 LH CSR3,CYLINCRF+2 GET TC 47220020 LCR CSR3,CSR3 FACTOR 47230020 RTACONV L CSR5,BGNADR GET BEGIN ADR RTA VALUE 47240020 LA GR6,BGNADR GET ADDRESS OF BEGIN RTA 47250020 BAL LINK9,RTACONV1 GO CONVERT IT 47260020 TM ENDSW,X'01' VDRL END ADDRESS REQUIRED 47270020 BO UTLPGM NO 47280020 L CSR5,ENDADR GET END RTA 47290020 LA GR6,ENDADR GET ADDRESS OF END RTA 47300020 BAL LINK9,RTACONV1 GO CONVERT IT 47310020 B START1 CALL UTILITY PROGRAM 47320020 SPACE 1 47330020 RTACONV1 SR CSR4,CSR4 CLEAR FOR DIVIDE 47340020 CLI UCBFRM,X'00' IS IT 2321 47350020 BE RTACONMF YES, SPECIAL CONVERT 47360020 DR CSR4,CSR3 DVD RTA/TC CSR4=HH;CSR5=CC 47370020 ST CSR4,0(GR6) HH IN TRK ADDRESS 47380020 STH CSR5,0(GR6) CC IN TRK ADDRESS 47390020 RTACONV2 CLC 0(4,GR6),UPPRLMT1 ADDRESS LARGER THAN UPPERLIMIT 47400020 BH SCANERR YES, ERROR 47410020 BR LINK9 NO, RETURN 47420020 SPACE 1 47430020 * CONVERT FOR 2321 47440020 SPACE 1 47450020 RTACONMF LA CSR3,20 GET TC FACTOR (20 TRKS/CYL) 47460020 DR CSR4,CSR3 RTA/20 CSR4=TRK;CSR5=CYL 47470020 ST CSR4,0(GR6) SAVE TRK ADDRESS 47480020 SR CSR4,CSR4 CLEAR FOR ANOTHER DIVIDE 47490020 LA CSR3,5 GET TC FACTOR (5 CYL/STRIP) 47500020 DR CSR4,CSR3 RTA/5 CSR4=CYL;CSR5=STRIP 47510020 STC CSR4,2(GR6) SAVE CYLINDER ADDRESS 47520020 SR CSR4,CSR4 CLEAR FOR ANOTHER DIVIDE 47530020 LA CSR3,10 GET TC FACTOR (10 STRIP/SUBC) 47540020 DR CSR4,CSR3 RTA/10 CSR4=STRIP;CSR5=SUBC 47550020 STC CSR4,1(GR6) SAVE STRIP ADDRESS 47560020 STC CSR5,0(GR6) SAVE SUBCELL ADDRESS. 47570020 B RTACONV2 RETURN 47580020 UTLPGM MVC ENDADR(4),UPPRLMT1 GET END ADDRESS 47590020 MVI FULLDPSW,X'F0' SET SWITCH TELLING FULL DUMP 47600020 MVI ENDSW,X'00' CLEAR VDRL END SWITCH 47610020 B START1 CALL UTILITY PROGRAM 47620020 DEVCTRL DS 0D S20201 47630020 D2321 DS 0D CODE 00 S20201 47640020 DC X'000000EC' CYLINDER CHANGE S20201 47650020 DC X'13050413' UPPER LIMIT (EXCLUD ALT) S20201 47660020 DC F'0' NOT USED S20201 47670020 DC X'0013' TRACKS/CYLINDER-1 S20201 47680020 DC X'0200' (MAX NO. OF RECORDS-1)X8 S20201 47690020 D2311 DS 0D CODE 01 S20201 47700020 DC X'0000FFF6' CYLINDER CHANGE S20201 47710020 DC X'00C70009' UPPER LIM (EXCLUD ALTS) S20201 47720020 DC F'4' INDEX FOR RLINK2 S20201 47730020 DC X'0009' TRACKS/CYLINDER-1 S20201 47740020 DC X'01D8' (MAX NO. OF RECORDS-1)X8 S20201 47750020 D2314 DS 0D CODE 02 S20201 47760020 DC X'0000FFEC' CYLINDER CHANGE S20201 47770020 DC X'00C70013' UPPER LIM (EXCLUD ALTS) S20201 47780020 DC F'8' INDEX FOR RLINK2 S20201 47790020 DC X'0013' TRACKS/CYLINDER-1 S20201 47800020 DC X'0240' (MAX NO. OF RECORDS-1)X8 S20201 47810020 D2302 DS 0D CODE 03 S20201 47820020 DC X'0000FFD2' CYLINDER CHANGE S20201 47830020 DC X'00F5002D' UPPER LIMIT S20201 47840020 DC F'0' NOT USED S20201 47850020 DC X'002D' TRACKS/CYLINDER-1 S20201 47860020 DC X'0280' (MAX NO. OF RECORDS-1)X8 S20201 47870020 D2303 DS 0D CODE 04 S20201 47880020 DC X'0000FFF6' CYLINDER CHANGE S20201 47890020 DC X'004F0009' UPPER LIMIT S20201 47900020 DC F'0' NOT USED S20201 47910020 DC X'0009' TRACKS/CYLINDER-1 S20201 47920020 DC X'0170' (MAX NO. OF RECORDS-1)X8 S20201 47930020 D2301 DS 0D CODE 05 S20201 47940020 DC X'0000FF38' CYLINDER CHANGE S20201 47950020 DC X'000000C7' UPPER LIMIT (INCL ALT) S20201 47960020 DC F'0' NOT USED S20201 47970020 DC X'00C8' TRKS/CYL-1 (NOCHANGE) S20201 47980020 DC X'04E0' (MAX NO. OF RECORDS-1)X8 S20201 47990020 D2305M1 DS 0D CODE 06 S20201 48000020 DC X'0000FFF8' CYLINDER CHANGE S20201 48010020 DC X'002F0007' UPPER LIMIT (EXCLUD ALT) S20201 48020020 DC F'0' NOT USED S20201 48030020 DC X'0007' TRACKS/CYLINDER-1 S20201 48040020 DC X'0108' (MAX NO. OF RCDS-1)X8 S20201 48050020 D2305M2 DS 0D CODE 07 S20201 48060020 DC X'0000FFF8' CYLINDER CHANGE S20201 48070020 DC X'005F0007' UPPER LIMIT (EXCLUD ALT) S20201 48080020 DC F'0' NOT USED S20201 48090020 DC X'0007' TRACKS/CYLINDER-1 S20201 48100020 DC X'0250' (MAX NO. OF RECORDS-1)X8 S20201 48110020 D2400 DS 0D CODE 08 S20201 48120020 DC 2F'0' NOT USED S20201 48130020 DC F'0' INDEX FOR RLINK2 S20201 48140020 DC F'0' NOT USED S20201 48150020 D3330 DS 0D CODE 09 S20201 48160020 DC X'0000FFED' CYLINDER CHANGE S20201 48170020 DC X'01930012' UPPER LIM (EXCLUD ALTS) S20201 48180020 DC F'12' INDEX FOR RLINK2 S20201 48190020 DC X'0012' TRACKS/CYLINDER-1 S20201 48200020 DC X'0308' (MAX NO OF RECORDS-1)X8 S20201 48210020 DUNUSED1 DS 0D CODE 0A S20201 48220020 DC 2F'0' UNUSED S20201 48230020 DC F'0' UNUSED S20201 48240020 DC F'0' UNUSED S20201 48250020 DUNUSED2 DS 0D CODE 0B S20201 48260020 DC 2F'0' UNUSED S20201 48270020 DC F'0' UNUSED S20201 48280020 DC F'0' UNUSED S20201 48290020 CTOEMASK DC X'2020' CONVERT C ZONE TO E ZONE 48300020 ALTTT DC X'0A0B0C0D0E0FDDDDDD' TABLE TO CONVERT TO HEX 48310020 DC X'DDDDDDDDDDDD' 48320020 DC X'00010203040506070809' 48330020 EJECT 48340020 BIT80 EQU X'80' ERROR SWITCH 48350020 BIT40 EQU X'40' BYPASS SWITCH 48360020 BIT20 EQU X'20' EOF, PARAMETER FOLLOWS SWITCH 48370020 BIT10 EQU X'10' FIRST ENTRY, PARTIAL PARAMETER 48380020 BIT08 EQU X'08' COMMAND, COLUMN 72 NON-BLANK SW 48390020 BIT04 EQU X'04' KEYWORD, COLUMN 72 NON-BLANK SW 48400020 BIT02 EQU X'02' PARAMETER SWITCH 48410020 BIT01 EQU X'01' RIGHT PAREN, LENGTH=0 SWITCH 48420020 EQUAL EQU C'=' HEX 'EQUAL' 48430020 COMMA EQU C',' HEX 'COMMA' 48440020 MINUS EQU C'-' HEX MINUS A30065 48450020 BLANKCOL EQU C' ' BLANK CHARACTER. 48460020 RESET0 EQU X'00' RESET BITS 48470020 CARDBUFF EQU SWITCHRD+1 CARD READ-IN AREA. 48480020 LASTCOLM EQU SWITCHRD+71 LAST COLUMN 48490020 PARAMSW EQU SWITCHRD+81 PARAMETER FOLLOWS, CONTINUATION 48500020 SAVEPAPR EQU SWITCHRD+83 SAVE AREA FOR PARTIAL PARAMETERS 48510020 COL72LG EQU SWITCHRD+103 COLUMN 72 SWITCH AND LENGTH SW 48520020 DELIMIN EQU SWITCHRD+106 DELIMITER INDICATORS 48530020 DELIMIN2 EQU SWITCHRD+107 DELIMITER INDI 48540020 SAVE9 EQU SWITCHRD+108 SAVE REGISTER 9 AREA 48550020 STORGR3 EQU SWITCHRD+112 LOCATION WHERE SCAN REG3 STORED 48560020 SPACE 1 48570020 RDCARD STM 3,15,REGSV6+12 SAVE REGS 3-15, 1-2 PARAM REGS 48580020 L GR3,STORGR3 POINTER FROM PREVIOUS SCAN SAVED 48590020 NI SWITCHRD,X'7F' RESET ERROR BIT 48600020 TM SWITCHRD,BIT10 TEST FIRST ENTRY SWITCH 48610020 BC 8,KIRSCD SWITCH OFF ON FIRST ENTRY 48620020 TM SWITCHRD,BIT40 TEST BYPASS SWITCH 48630020 BC 1,KBYPO IF ON GO TO BYPASS ROUTINE 48640020 TM PARAMSW,BIT08 TEST READ CARD SWITCH 48650020 BC 1,KGTCD IF ON, READ A CARD 48660020 TM PRNTSW,X'01' IS PRINT SWITCH ON 48670020 BC 8,KPFOL NO-DO NOT PRINT NOW 48680020 BAL LINK9,KPRNT PRINT THE CARD 48690020 OI PRNTSW,X'20' INDICATE CARD PRINTED 48700020 NI PRNTSW,X'FE' CLEAR EXTRANEOUS BITS 48710020 KPFOL TM PARAMSW,BIT20 DOES A PARAMETER FOLLOW 48720020 BC 1,SCANR YES- SCAN THE CARD 48730020 TM PARAMSW,BIT40 CONTINUATION SWITCH SET 48740020 BC 1,KCONT YES- PROCESS CONTINUED PART 48750020 LA GR3,CARDBUFF LOAD ADDRESS OF FIRST COLUMN 48760020 KNAME CLI 0(GR3),BLANKCOL IS COLUMN BLANK 48770020 LA GR5,LASTCOLM LOAD 5 WITH COLUMN 71 OF CARD 48780020 BE KOMMD YES- GO TO COMMAND WORD ROUTINE 48790020 CR GR3,GR5 TEST IF SCANNED TO COLUMN 71 48800020 BE KNOP YES- END OF CARD REACHED 48810020 LA GR3,1(GR3) GO TO NEXT COLUMN 48820020 B KNAME CHECK FOR BLANK 48830020 KOMMD LA GR3,1(GR3) SPACE TO NEXT COLUMN AFTER COMD 48840020 OI PARAMSW,BIT04 SET COMMAND SWITCH PARAM FOLLOW 48850020 OI SWITCHRD,BIT08 SET COMMAND BIT '08' 48860020 NI DELIMIN,RESET0 RESET DELIMITER INDICATORS 48870020 KABC CLI 0(GR3),BLANKCOL IS COLUMN BLANK 48880020 BNE SCAN NO- CHECK PARAMETER 48890020 CR GR3,GR5 IS THIS THE END COLUMN 48900020 BE KNOP YES- END OF CARD REACHED 48910020 LA GR3,1(GR3) ADJUST POINTER TO NEXT COLUMN 48920020 B KABC CONTINUE SCAN 48930020 KCONT LA GR3,SWITCHRD+16 SET POINTER TO COLUMN 16 48940020 NI DELIMIN,RESET0 CLEAR DELIMITER SWITCHES 48950020 SCANR NI SWITCHRD,X'F7' RESET COMMAND BIT 48960020 SCAN NI SWITCHRD,X'98' RESET ALL BUT ERROR, 1ST ENTRY 48970020 NI PARAMSW,X'14' RESET ALL BITS BUT COMD CNTL SW 48980020 MVC DELIMIN2(1),DELIMIN SAVE DELIMITER SWITCH SETTINGS 48990020 NI COL72LG,X'0C' RESET EXIT CONTROL SWITCH 49000020 NI DELIMIN,RESET0 CLEAR DELIMITER SWITCH 49010020 SR GR2,GR2 CLEAR REGISTER 49020020 LR GR1,GR3 SAVE POINTER TO PRESENT COLUMN 49030020 LA GR5,LASTCOLM LOAD ADDRESS OF END COLUMN 49040020 KOMPAR CLI 0(GR3),EQUAL IS CHARACTER A DELIMITER 49050020 BNH DELIMIT YES-'EQUAL' CHARACTER OR LOWER 49060020 KOMPARA LA GR2,1(GR2) ADD ONE TO LENGTH A30065 49070020 CR GR3,GR5 IS THIS THE END COLUMN 49080020 BE KPART YES-GO TO PARTIAL PARAMETER SAVE 49090020 LA GR3,1(GR3) UP POINTER TO NEXT COLUMN 49100020 B KOMPAR CONTINUE SCANNING FOR DELIMITER 49110020 KNOP OI SWITCHRD,BIT80 FLAG AS NO COMD OR PARAM ON CARD 49120020 LM 1,2,ZERO CLEAR LENGTH AND SCAN REGISTERS 49130020 KNOPAR OI SWITCHRD,BIT40 NO KEYWORD OR PARAMETERS FOLLOW 49140020 KPASS LA GR3,1(GR3) UP POINTER TO NEXT COLUMN 49150020 NI PARAMSW,X'EB' CLEAR ALL BUT BYPASS-PART PARAM. 49160020 ST GR3,STORGR3 SAVE REG3 FOR NEXT ENTRY 49170020 LM 3,15,REGSV6+12 RESTORE REGISTERS 3-15, 1,2 SET 49180020 BR LINK14 RETURN TO USER. 49190020 DELIMIT CLI 0(GR3),MINUS IS THIS A HYPHEN A30065 49200020 BE KOMPARA YES - THIS IS OKAY. A30065 49210020 CR GR3,GR5 IS THIS END COLUMN. A30065 49220020 BE SETCC2 YES- SET INDICATOR 49230020 OI COL72LG,BIT40 SET DELIMITER BEFORE LAST SWITCH 49240020 TM PARAMSW,BIT10 IS PARTIAL PARAMETER SWITCH ON 49250020 BC 1,KPPAR YES-COMPLETE PARAMETER 49260020 B TESTPAR CHECK PARAMETER 49270020 LENGTH0 OI COL72LG,BIT01 SET LENGTH EQUAL TO ZERO 49280020 B DELIM CHECK DELIMITERS 49290020 SETCC2 OI COL72LG,BIT20 SET DELIMITER IN LAST SWITCH 49300020 TM PARAMSW,BIT10 IS PARTIAL PARAMETER SWITCH ON 49310020 BC 1,KTERBY YES- LENGTH IS TOO LONG 49320020 TESTPAR SR GR4,GR4 CLEAR REGISTER 49330020 AR GR4,GR2 ADD LENGTH 49340020 BC 8,LENGTH0 LENGTH EQUALS ZERO, SET SWITCH 49350020 OI COL72LG,BIT02 SET LENGTH GREATER THAN ZERO 49360020 DELIM CLI 0(GR3),EQUAL TEST IF DELIMITER IS AN EQUAL 49370020 BE KEY YES- GO TO KEY WORD ROUTINE 49380020 CLI 0(GR3),COMMA TEST FOR COMMA 49390020 BE PARAMC YES- GO TO PARAMETER ROUTINE 49400020 CLI 0(GR3),BLANKCOL TEST FOR BLANK 49410020 BE PARBLANK YES- GO TO HANDLE BLANK PARAM 49420020 OI SWITCHRD,BIT80 SET ERROR BIT 49430020 TM COL72LG,BIT20 IS DELIMITER IN END COLUMN 49440020 BC 1,KSETP YES- SET PARAMETER FOLLOWS SW. 49450020 KINVAL OI SWITCHRD,BIT80 SET INVALID DELIMITER ERROR SW 49460020 LA GR2,1(GR2) ADJUST LENGTH REGISTER 49470020 LA GR3,1(GR3) ADJUST SCAN POINTER 49480020 CLI 0(GR3),EQUAL TEST FOR DELIMITER 49490020 BNH KINV YES- TWO DELIMITERS IN A ROW 49500020 CR GR3,GR5 END COLUMN 49510020 BL KINVAL NO- SCAN SOME MORE 49520020 TM COL72LG,BIT08 IS COLUMN 72 BLANK 49530020 BC 1,KTERBY YES 49540020 LA GR2,1(GR2) UP LENGTH REGISTER 49550020 B KPTERR ESTABLISH PARAMETER 49560020 KINV TM PARAMSW,BIT04 IS COMMAND CONTROL SWITCH ON 49570020 BC 1,KPCMD YES- ADJUST POINTER TO NEXT ONE 49580020 PRFOL OI PARAMSW,BIT20 SET PARAMETER FOLLOWS SWITCH 49590020 B KPASS GO TO RETURN 49600020 KBYPO CLI SWITCHRD+72,BLANKCOL IS COLUMN 72 BLANK 49610020 BNE KGTCD NO- GET ANOTHER CARD 49620020 NI SWITCHRD,BIT10 RESET PARTIAL PARAMETER SWITCH 49630020 NI PARAMSW,RESET0 RESET ENTRY CONTROL SWITCH 49640020 NI PRNTSW,X'DE' RESET EXTRANEOUS BITS 49650020 B KGTCD READ A CARD 49660020 KIRSCD OI SWITCHRD,BIT10 SET FIRST ENTRY SWITCH 49670020 SR GR3,GR3 CLEAR SCAN REGISTER 49680020 STC GR3,PARAMSW CLEAR PARAMETER SWITCH 49690020 STC GR3,COL72LG CLEAR COLUMN 72 SWITCH 49700020 KGTCD LA GR2,CARDBUFF ADDRESS OF INPUT BUFFER 49710020 BAL LINK15,SYSIN READ A CARD FROM INPUT DEVICE 49720020 TM PRNTSW,X'20' TEST DELAY PRINT SETTING 49730020 BC 8,KGTCDR DD NOT PRINT CARD NOW 49740020 BAL GR9,KPRNT PRINT CARD 49750020 KGTCDR NI COL72LG,RESET0 CLEAR COLUMN 72 SWITCH 49760020 CLI SWITCHRD+72,BLANKCOL IS COLUMN 72 BLANK 49770020 BNE CLMNOTBL COLUMN 72 IS NOT BLANK 49780020 OI COL72LG,BIT08 SET 72 BLANK SWITCH 49790020 RETURN TM SWITCHRD,BIT40 IS BYPASS SWITCH ON 49800020 BC 1,KBYPO YES- BYPASS CARD 49810020 B KPFOL START SCAN 49820020 CLMNOTBL OI COL72LG,BIT04 SET 72 NOT BLANK SWITCH IN CASE 49830020 B RETURN CHECK SOME MORE 49840020 PARBLANK TM PARAMSW,BIT04 IS COMMAND SWITCH ON 49850020 BC 1,KPCMD YES-GO TO ADJUST POINTER 49860020 OI SWITCHRD,BIT02 SET PARAMETER PRESENT BIT 49870020 OI DELIMIN,BIT08 SET BLANK DELIMITER SWITCH 49880020 DECID TM COL72LG,BIT20 IS DELIMITER IN END COLUMN 49890020 BC 1,KWENT YES- SET TO READ A CARD 49900020 TM COL72LG,BIT01 IS LENGTH EQUAL TO ZERO 49910020 BC 1,KFORZRO YES-SET UP FOR ZERO LENGTH 49920020 OI PARAMSW,BIT20 SET PARAMETER FOLLOWS SWITCH 49930020 TM DELIMIN,BIT08 IS DELIMITER A BLANK 49940020 BC 8,KPASS NO- RETURN WITH POINTERS SET 49950020 KETBYP OI SWITCHRD,BIT40 SET BYPASS SWITCH 49960020 B KPASS GET SET TO RETURN 49970020 KFORZRO LM GR1,GR2,ZERO CLEAR REGISTERS 1 AND 2 49980020 TM DELIMIN,BIT08 IS DELIMITER A BLANK 49990020 BC 1,KETRDCD GO TO SET READ CARD AND CONTINUE 50000020 OI PARAMSW,BIT20 SET PARAMETER FOLLOWS SWITCH 50010020 TM DELIMIN,BIT80 IS DELIMITER AN EQUAL SIGN 50020020 BC 1,KTER YES- SET UP ERROR CONDITION 50030020 B KPASS RETURN 50040020 KETRDCD OI PARAMSW,X'48' SET TO READ CARD AND CONTINUE 50050020 TM DELIMIN2,BIT40 IS LAST DELIMITER A COMMA 50060020 BC 1,KGTCD YES- READ A CARD 50070020 TM COL72LG,BIT08 IS COLUMN 72 BLANK 50080020 BC 8,KETBYP NO- SET BYPASS SWITCH AND RETURN 50090020 LA GR4,SWITCHRD+16 CARD COLUMN 16 50100020 CR GR3,GR4 IS SCAN ON COLUMN 16 50110020 BE KETBYP YES- SET BYPASS SWITCH 50120020 TM DELIMIN2,EQUAL WAS LAST DELIMITER AN EQUAL 50130020 BC 1,KETBYP YES- SET BYPASS SWITCH 50140020 KTERBY OI SWITCHRD,BIT40 SET BYPASS SWITCH 50150020 KTER OI SWITCHRD,BIT80 SET ERROR SWITCH 50160020 B KPASS RETURN 50170020 KWENT OI PARAMSW,X'48' SET TO READ CARD AND CONTINUE 50180020 TM COL72LG,BIT08 IS COLUMN 72 BLANK 50190020 BC 1,KETCTBL YES- SET BYPASS SWITCH AND CHECK 50200020 TM COL72LG,BIT01 IS LENGTH EQUAL TO ZERO 50210020 BC 1,KZERO NO- RETURN 50220020 TM DELIMIN,BIT08 IS DELIMITER A BLANK 50230020 BC 1,KETBYP YES- SET BYPASS SWITCH, RETURN 50240020 B KPASS RETURN 50250020 KZERO SR GR1,GR1 CLEAR REGISTER 50260020 TM DELIMIN,BIT80 IS DELIMITER AN EQUAL 50270020 BC 1,KTER YES- SET ERROR SWITCH 50280020 TM DELIMIN,BIT40 IS DELIMITER A COMMA 50290020 BC 8,KGTCD NO- READ A CARD 50300020 CLC DELIMIN(1),DELIMIN2 IS DELIMITER SAME AS LAST 50310020 BE KPASS YES- RETURN 50320020 KETCTBL OI SWITCHRD,BIT40 SET BYPASS SWITCH 50330020 TM DELIMIN,BIT40 IS DELIMITER A COMMA 50340020 BC 1,KTER YES- SET ERROR SWITCH 50350020 B KPASS RETURN 50360020 KEY OI SWITCHRD,BIT04 SET KEY WORD SWITCH 50370020 OI DELIMIN,BIT80 SET DELIMITER SWITCH 50380020 B DECID GO TO CHECK DELIMITER 50390020 PARAMC OI SWITCHRD,BIT02 SET PARAMETER BIT 50400020 OI DELIMIN,BIT40 SET DELIMITER COMMA SWITCH 50410020 B DECID GO TO CHECK DELIMITER 50420020 KPART TM PARAMSW,BIT10 IS PARTIAL PARAMETER SWITCH ON 50430020 BC 1,KTERBY YES-SET BYPASS AND ERROR SWITCH 50440020 KPTERR OI PARAMSW,BIT10 SET PARTIAL PARAMETER SWITCH 50450020 TM COL72LG,BIT08 IS COLUMN 72 BLANK 50460020 BC 1,KLAST YES- GO TO SET PARAMETER BIT 50470020 MVI SAVEPAPR,BIT40 FLAG PARTIAL PARAMETER STORED 50480020 MVC SAVEPAPR+1(19),SAVEPAPR STORE PARTIAL PARAMETER 50490020 STC GR2,SWITCHRD+82 SAVE LENGTH OF PARTIAL PARAMETER 50500020 BCTR GR2,0 DECREMENT COUNT FOR MOVE 50510020 EX GR2,MOVEP MOVE PARTIAL PARAMETER TO BUFFER 50520020 OI PARAMSW,BIT40 SET CONTINUE BIT 50530020 TM COL72LG,BIT04 IS COLUMN 72 BLANK 50540020 BC 1,KGTCD NO- GET A CARD 50550020 OI SWITCHRD,BIT80 YES- FLAG AS ERROR 50560020 B KETBYP SET BYPASS SWITCH 50570020 KLAST OI SWITCHRD,BIT02 SET PARAMETER BIT 50580020 B KETBYP SET BYPASS BIT 50590020 KPPAR SR GR4,GR4 CLEAR REGISTER 50600020 IC GR4,SWITCHRD+82 LENGTH OF FIRST PART. 50610020 LTR GR2,GR2 IS LENGTH OF 2ND PART ZERO. 50620020 BC 8,KOMPL YES-THE PARAMETER IS COMPLETE. 50630020 LA GR6,SAVEPAPR NO--ADDRESS OF FIRST PART. 50640020 AR GR6,GR4 ADDRESS TO MOVE IN 2ND PART. 50650020 BCTR GR2,0 DECREMENT COUNT FOR MOVE 50660020 EX GR2,MOVEPP RECREATE COMPLETE PARAMETER. 50670020 LA GR2,1(GR2) UP COUNT TO WHERE IT WAS 50680020 KOMPL AR GR2,GR4 TOTAL LENGTH OF PARAMETER. 50690020 LA GR1,SAVEPAPR LOAD PARAMETER BUFFER ADDRESS 50700020 NI COL72LG,X'0C' CLEAR LENGTH BITS, LEAVE'72' BIT 50710020 OI COL72LG,X'42' SET LENGTH GREATER THAN ZERO 50720020 MVC DELIMIN2(1),DELIMIN SAVE DELIMITER SWITCH SETTINGS 50730020 NI DELIMIN,RESET0 CLEAR DELIMITER BITS 50740020 NI PARAMSW,X'EF' RESET PARTIAL PARAMETER SWITCH 50750020 B DELIM CHECK DELIMITERS 50760020 KPCMD LA GR3,1(GR3) ADJUST POINTER TO NEXT COLUMN 50770020 CLI 0(GR3),BLANKCOL IS COLUMN BLANK 50780020 BNE KPCMA NO- CHECK FOR COMMA 50790020 CR GR5,GR3 IS THIS THE LAST COLUMN 50800020 BE KNOPAR YES- NO PARAMETER FOLLOWS 50810020 B KPCMD CONTINUE SCAN 50820020 KPCMA CLI 0(GR3),COMMA IS COMMA THE FIRST CHARACTER 50830020 BE KNOPAR YES- NO PARAMETER FOLLOWS 50840020 BCTR GR3,0 BACK UP REGISTER 3 TO PARAMETER 50850020 B PRFOL GO TO SET UP FOR PARAMETER 50860020 KSETP OI PARAMSW,BIT10 SET PARAMETER FOLLOWS SWITCH 50870020 LA GR2,1(GR2) UP LENGTH 50880020 B KPTERR GO TO SET PARTIAL PARAMETER BIT 50890020 KPRNT MVC PRWD(80),CARDBUFF MOVE CONTROL CARD TO BUFFER 50900020 WASH LA GR1,71 SIZE OF CARD IN BYTES SA58009 50910021 ST GR9,SAVE9 SAVE REGISTER 9 TEMPORARILY 50920020 LA GR9,PRWD LOAD BUFFER ADDRESS SA58009 50922021 AR GR9,GR1 LOCATE BUFFER AT END SA58009 50924021 RANDLE CLI 0(GR9),C' ' BLANK SPACE SA58009 50926021 BNE MTS NO - EXIT SA58009 50928021 BCTR GR9,0 DECREMENT BUFFER ADDR SA58009 50928421 BCT GR1,RANDLE DECREMENT COUNTER SA58009 50928821 MTS LA GR1,1(GR1) ADD 1 TO COUNTER SA58009 50929221 BAL GR9,PRNT PRINT THE CARD 50930020 L GR9,SAVE9 RELOAD REGISTER 9 50940020 BR GR9 RETURN TO USER 50950020 MOVEP MVC SAVEPAPR(1),0(GR1) STORE PARTIAL PARAMETER 50960020 MOVEPP MVC 0(1,GR4),0(GR1) RECREATES PARAMETER 50970020 ORG1101X EQU * S20201 50980020 ORG ENTER+30976 ECF CODE AREA S20201 50990020 EJECT 51000020 ECFCODE BALR 7,0 ESTABLISH BASE S20201 51010020 USING *,7 NEW BASE S20201 51020020 ECFCODE1 MVC CSWADDR(L3),L17(UCBREG) GET RESTART CSW ADDR S20201 51030020 LH ECFREG2,IOSESV+L18 FETCH BACKWARDS DISP S20201 51040020 N ECFREG2,CLEARHI2 CLEAR HI-ORDER BYTES S20201 51050020 LH ECFREG3,L18(UCBREG) GET CCW FROM CSW S20201 51060020 N ECFREG3,CLEARHI2 CLEAR HI-ORDER BYTES S20201 51070020 S ECFREG3,EIGHT GET CCW ADDR IN ERROR S20201 51080020 MVC ECFCNT+L2(L2),L6(ECFREG3) SAVE CCW COUNT S20201 51090020 CLI ZERR(UCBREG),T3330 IS DEVICE A 3330 S20201 51100020 BNE DISPZ NO,SET 2305 DISP S20201 51110020 MVC TOTALCNT+L1(L3),IOSESV+L15 FETCH RESTART DISP S20201 51120020 L ECFREG1,TOTALCNT LOAD S20201 51130020 SR ECFREG1,ECFREG2 CALC FORWARD DISP S20201 51140020 B ECCNT SKIP 2305 CODE S20201 51150020 DISPZ L ECFREG1,ECFCNT GET CCW COUNT S20201 51160020 SR ECFREG1,ECFREG2 DECR BY ECC DISP S20201 51170020 LH ECFREG2,RESIDCNT FETCH RESIDUAL COUNT S20201 51180020 N ECFREG2,CLEARHI2 CLEAR HI-ORDER BYTES S20201 51190020 SR ECFREG1,ECFREG2 DECR BY RESIDUAL COUNT S20201 51200020 ECCNT LA ECFREG2,IOSESV+L20 PT. TO ECC DATA S20201 51210020 LA ECFREG4,L3 SET LOOP COUNT S20201 51220020 ECFLOOP1 CL ECFREG1,ECFCNT ERROR IN THIS SEGMENT S20201 51230020 BNL ENDSEG NO S20201 51240020 L ECFREG5,ZERR(ECFREG3) GET DATA ADDRESS M3390 51246020 N ECFREG5,CLEARHI2 CLEAR OP CODE M3390 51252020 AR ECFREG5,ECFREG1 ADD FORWARD DISPLACEMENT S20201 51260020 CLI ZERR(ECFREG2),ZERR IS ECC BYTE ZERO S20201 51270020 BE ECFINCR YES, SKIP EXCL-OR S20201 51280020 TM L4(ECFREG3),SKIP IS SKIP FLAG ON S20201 51290020 BO ECFINCR YES, SKIP EXCL-OR S20201 51300020 XC ZERR(L1,ECFREG5),ZERR(ECFREG2) DO IT S20201 51310020 ECFINCR LA ECFREG2,L1(ECFREG2) PT TO NEXT ECC BYTE S20201 51320020 CLI ZERR(UCBREG),T23A5 IS THIS A 2305-1 S20201 51330020 BNE ECFINCR1 NO, SKIP S20201 51340020 LA ECFREG1,L1(ECFREG1) 2305-1 GET 2 INCREMENTS S20201 51350020 ECFINCR1 LA ECFREG1,L1(ECFREG1) INCREMENT LOOP S20201 51360020 BCT ECFREG4,ECFLOOP1 DECREMENT LOOP COUNT S20201 51370020 ENDSEG CLI ZERR(UCBREG),T3330 IS DEVICE A 3330 S20201 51380020 BNE ECFOVCK NO, SKIP S20201 51390020 TM L4(ECFREG3),DCHAIN IS THIS DATA CHAINING S20201 51400020 BZ ECFOVCK NO,CHECK FOR CMD CHAIN S20201 51410020 L ECFREG6,TOTALCNT FETCH S20201 51420020 S ECFREG6,ECFCNT DECR BY CCW COUNT S20201 51430020 ST ECFREG6,TOTALCNT RESTORE S20201 51440020 S ECFREG1,ECFCNT DECR DISP BY CCW COUNT S20201 51450020 LA ECFREG3,L8(ECFREG3) INCR TO NEXT CCW S20201 51460020 CLI ZERR(ECFREG3),CMDTIC IS IT A TIC S20201 51470020 BNE SETECNT NO, UPDATE ECFCNT S20201 51480020 L ECFREG3,ZERR(ECFREG3) YES, POINT TO TIC S20201 51490020 SETECNT MVC ECFCNT+L2(L2),L6(ECFREG3) UPDATE COUNT AREA S20201 51500020 B ECFLOOP1 LOOP S20201 51510020 TM IOSESV+L1,CHNGCYL IS OPERATION INCOMPLETE S20201 51520020 BO ENDCHAIN YES, RETURN TO PROCESS S20201 51530020 ECFOVCK TM L4(ECFREG3),CYLHI IS COMMAND CHAINING ON S20201 51540020 BZ ENDCHAIN BR IF LAST CCW IN CHAIN S20201 51550020 LA ECFREG2,L8(ECFREG3) PT TO NEXT CCW S20201 51560020 CLI ZERR(ECFREG3),CMDTIC IS IT A TIC S20201 51570020 BNE NOTIC NO TIC, SKIP S20201 51580020 L ECFREG2,ZERR(ECFREG2) YES,PT TO NEXT CCW S20201 51590020 NOTIC TM ZERR(ECFREG2),CNTFLD COUNT OPERATION S20201 51600020 MVC CSWTIC+L1(L3),CSWADDR SET TIC ADDRESS M3390 51605020 BZ ECFBLD1 BR IF COUNT OPERATION S20201 51610020 MVC CCWADD(L8),CSWTIC DELETE RD CNT CCW S20201 51620020 B ECFBLD BUILD RESTART CCW S20201 51630020 ECFBLD1 MVC CCWADD(L16),RDCNT INSERT RD CNT CCW S20201 51640020 ECFBLD MVC ECFCC+L3(L1),IOSESV+L5 GET CYLINDER ADDR S20201 51650020 MVC ECFCC+L5(L1),IOSESV+L6 GET HEAD ADDRESS S20201 51660020 TM ECFCC+L5,CYLHI IS CYLINDER HI BIT ON S20201 51670020 BNO ECFIDEQ BYPASS CYL CHANGE S20201 51680020 MVI ECFCC+L3,CHNGCYL INCR CYL BY 256 S20201 51690020 ECFIDEQ NI ECFCC+L5,X'1F' CLEAR HI ORDER HD BYTE S20201 51700020 MVC ECFADDR(L5),IOSESV+L8 MOVE IN CCHHR S20201 51710020 LM BASE0,REGF,REGSAVE RESTORE REGISTERS M3390 51720020 LA RCAW,ECFSEEK LOAD RESTART CCW S20201 51730020 LM GR8,LINK15,REGSAVE+L32 RESTORE REST OF REGS M3390 51735020 BAL LINK9,STARTIO START IO S20201 51740020 ENDCHAIN EQU * RETURN TO PROCESS S20201 51750020 DROP 7 DROP BASE REG S20201 51760020 B ECFRTN RETURN M3390 51770020 EJECT 51780020 * *************************************************** 51790020 * * CHANNEL PROGRAM AND CONSTANTS FOR ECF * 51800020 * *************************************************** 51810020 ECFSEEK CCW 7,ECFCC,X'40',6 SEEK S20201 51820020 CCW X'1F',FILEMASK,X'40',1 SET FILE MASK S20201 51830020 ECFTIC CCW X'31',ECFADDR,X'60',5 SEARCH ID EQUAL S20201 51840020 CCW 8,ECFTIC,0,0 REPEAT UNTIL FOUND S20201 51850020 CCWADD DS 2D CCW AREA S20201 51860020 RDCNT CCW X'12',CTDATA,X'70',8 READ COUNT CCW S20201 51870020 CSWTIC CCW 8,CSWADDR,0,0 TIC TO CSW ADDR S20201 51880020 SPACE 2 51890020 CTDATA DC X'00' COUNT READ IN AREA S20201 51900020 CSWADDR DC XL3'00' CSW RESTART ADDR S20201 51910020 ECFADDR DC XL5'00' SEARCH ID EQ ADDRESS S20201 51920020 DS 0H S20201 51930020 ECFCC DC XL6'00' SEEK ADDRESS S20201 51940020 TOTALCNT DC F'0' START COUNT AREA S20201 51950020 ECFCNT DC F'0' CCW COUNT AREA S20201 51960020 CLEARHI2 DC X'0000FFFF' CLEAR HIGH ORDER BYTES S20201 51970020 ORG1100X EQU * 5274 51980020 ORG ENTER+31488 5274 51990020 ORG1200 EQU * 5274 52000020 CTBUFFER DS 160D COUNT FIELDS READ IN HERE. 52010020 ORG1200X EQU * 5274 52020020 END START 52030020 ./ ADD SSI=00010510,NAME=ICAPRTBL,SOURCE=1 TITLE 'ICAPRTBL' 00010000 LCLA &T,&SPN 0001 00020000 .@001 ANOP 0001 00030000 ICAPRTBL CSECT , 0001 00040000 REPRO 00050000 Q}-&& 00060000 REPRO 00070000 ÷&0^0}&^0Y^00j0j1j1000j00080000 REPRO 00090000 1jX0b1jN0b\0Y1ݍ0d00Y0 100Y 00100000 DS 0H 00110000 * THE FOLLOWING IS USED TO INITIALIZE THE PERMANENT STORAGE 00120000 * REQUIREMENTS OF THE SYSTEM 00130000 * 00140000 * REGISTER USAGE 00150000 * 00160000 ZEROR EQU 0 NULL REGISTER 00170000 * 00180000 * 00190000 USING SNSBYTS,ZEROR,BASER ESTABLISH ADDRESSABILITY 00200000 SNSBYTS DC XL8'0' DEVICE SENSE FOR DISPLAY 00210000 ORG *+16 INITIAL PROGRAM LOADING CCWS 00220000 EXTOPSW DS 8C EXTERNAL OLD PSW 00230000 SVCOPSW DS 8C SUPERVISOR CALL OLD PSW 00240000 PGMOPSW DS 8C PROGRAM OLD PSW 00250000 MCOPSW DS 8C MACHINE CHECK OLD PSW 00260000 IOOPSW DS 8C INPUT/OUTPUT OLD PSW 00270000 CSW DS 8C CHANNEL STATUS WORD 00280000 CAW DS 4C CHANNEL ADDRESS WORD 00290000 TIMER DC X'0000000000FFFF0000000000' INITIAL TIMER VALUE 00300000 EXTNPSW DC XL5'0' EXTERNAL NEW PSW 00310000 DC AL3(INIT300) 00320000 SVCNPSW DC XL5'0' SUPERVISOR CALL NEW PSW 00330000 DC AL3(INIT400) 00340000 PGMNPSW DC XL5'0' PROGRAM NEW PSW 00350000 DC AL3(INIT500) 00360000 MCNPSW DC XL5'0' MACHINE CHECK NEW PSW 00370000 DC AL3(INIT600) 00380000 IONPSW DC XL5'0' INPUT/OUTPUT NEW PSW 00390000 DC AL3(INIT700) 00400000 SCANOUT DS CL332 DIAGNOSTIC SCAN-OUT AREA 00410000 DS 0H 00420000 @EL01 BCR 15,@E 0016 00430000 INIT EQU * 0016 00440000 * GENERATE(L BASER,SYSBAS); /* INITIALIZE SECOND BASE REG * 00450000 L BASER,SYSBAS 00460000 DS 0H 00470000 * SAVER = ADDR(INITSAVE); /* INITIALIZE REG SAVE ADDR * 00480000 LA @D,INITSAVE 0023 00490000 * INIT100: GENERATE(LPSW UTPSW); /* LOAD UTILITY PSW * 00500000 INIT100 LPSW UTPSW 00510000 DS 0H 00520000 * INIT200: RDRADDR = RDRR; /* SAVE INPUT DEVICE ADDRESS * 00530000 INIT200 ST @B,RDRADDR 0025 00540000 * CALL INPUT; /* READ IN CONTROL STATEMENTS * 00550000 BAL @E,INPUT 0026 00560000 * /* * 00570000 * /* ENTRY POINT FOR EXTERNAL INTERRUPTS * 00580000 * /* * 00590000 * INIT300: ERRCODE = CB0A; /* SET EXTERNAL INT ERROR CODE* 00600000 INIT300 MVC ERRCODE(3),CB0A 0027 00610000 * CALL WAIT; /* DISPLAY CODE AND WAIT * 00620000 BAL @E,WAIT 0028 00630000 * /* * 00640000 * /* ENTRY POINT FOR SUPERVISOR CALL INTERRUPTS * 00650000 * /* * 00660000 * INIT400: GENERATE(LPSW SVCOPSW); /* IGNORE SVC INTERRUPTIONS * 00670000 INIT400 LPSW SVCOPSW 00680000 DS 0H 00690000 * /* * 00700000 * /* ENTRY POINT FOR PROGRAM CHECK INTERRUPTIONS * 00710000 * /* * 00720000 * INIT500: ERRCODE = CB0B; /* SET PGM CHECK ERROR CODE * 00730000 INIT500 MVC ERRCODE(3),CB0B 0030 00740000 * CALL WAIT; /* DISPLAY CODE AND WAIT * 00750000 BAL @E,WAIT 0031 00760000 * /* * 00770000 * /* ENTRY POINT FOR MACHINE CHECK INTERRUPTIONS * 00780000 * /* * 00790000 * INIT600: ERRCODE = CB0B; /* SET MCH CHECK ERROR CODE * 00800000 INIT600 MVC ERRCODE(3),CB0B 0032 00810000 * GENERATE(B IO900); /* PREPARE FOR SEREP * 00820000 B IO900 00830000 DS 0H 00840000 * /* * 00850000 * /* ENTRY POINT FOR INPUT/OUTPUT INTERRUPTIONS * 00860000 * /* * 00870000 * INIT700: GENERATE(LPSW IOOPSW); /* IGNORE I/O INTERRUPTIONS * 00880000 INIT700 LPSW IOOPSW 00890000 DS 0H 00900000 * GENERATE; 00910000 DS 0F 00920000 SYSBAS DC X'00001000' SECOND BASE REGISTER VALUE 00930000 DS 0H 00940000 * END INIT; /* * 00950000 @EL02 BCR 15,@E 0036 00960000 * INPUT: /* READ INPUT ROUTINE * 00970000 * PROCEDURE; 00980000 INPUT STM @E,@C,12(@D) 0037 00990000 ST @D,@SAV003+4 0037 01000000 LA @F,@SAV003 0037 01010000 ST @F,8(0,@D) 0037 01020000 LR @D,@F 0037 01030000 * /******************************************************************** 01040000 * /* * 01050000 * /* * 01060000 * /* NAME * 01070000 * /* INPUT * 01080000 * /* * 01090000 * /* FUNCTION * 01100000 * /* THIS ROUTINE IS USED TO READ AND ANALYZE THE JOB CONTROL * 01110000 * /* CARDS. * 01120000 * /* * 01130000 * /* ENTRY POINTS * 01140000 * /* INPUT- THIS POINT IS GIVEN CONTROL BY THE INIT ROUTINE. * 01150000 * /* * 01160000 * /* INPUT * 01170000 * /* INPUT TO THIS ROUTINE IS A SET OF USER WRITTEN JOB CONTROL * 01180000 * /* CARDS. * 01190000 * /* * 01200000 * /* OUTPUT * 01210000 * /* NONE * 01220000 * /* * 01230000 * /* EXTERNAL ROUTINES * 01240000 * /* IO * 01250000 * /* * 01260000 * /* EXITS, NORMAL * 01270000 * /* THE CNTRL ROUTINE IS CALLED AFTER ALL CARDS ARE READ IN. * 01280000 * /* * 01290000 * /* EXITS, ERROR * 01300000 * /* THE WAIT ROUTINE IS CALLED IF AN ERROR IN THE CONTROL CARDS * 01310000 * /* IS DETECTED. * 01320000 * /* * 01330000 * /* TABLE/WORK AREAS * 01340000 * /* ERB02 * 01350000 * /* ERB03 * 01360000 * /* ERB04 * 01370000 * /* ERB05 * 01380000 * /* ERB06 * 01390000 * /* ERB07 * 01400000 * /* UCSLOAD * 01410000 * /* PTRADDR * 01420000 * /* UCSNMST * 01430000 * /* FCBNMST * 01440000 * /* ERRCODE * 01450000 * /* FCBIMG * 01460000 * /* * 01470000 * /******************************************************************** 01480000 * DECLARE 01490000 * /* THE FOLLOWING ARE SUBROUTINES OF INPUT * 01500000 * INTRP INTERNAL ENTRY, /* INTERPRET DATA ROUTINE * 01510000 * GET INTERNAL ENTRY, /* READ A CARD ROUTINE * 01520000 * SEARCH INTERNAL ENTRY, /* FIND FIRST BLANK ROUTINE * 01530000 * SEEK INTERNAL ENTRY; /* FIND FIRST NONBLANK ROUTINE* 01540000 * DECLARE 01550000 * /* IF A FLAG BIT IS ON THAT STATEMENT HAS BEEN READ IN * 01560000 * 1 FLAG BIT(8), /* CONTROL CARD FLAG BITS * 01570000 * 2 JOBFLAG BIT(1), /* JOB STATEMENT * 01580000 * 2 UCSFLAG BIT(1), /* UCS STATEMENT * 01590000 * 2 FCBFLAG BIT(1), /* FCB STATEMENT * 01600000 * 2 DFNFLAG BIT(1), /* DFN STATEMENT * 01610000 * 2 ENDFLAG BIT(1); /* END STATEMENT * 01620000 * DECLARE 01630000 * /* IF A FLAG BIT IS ON THAT DFN PARAMETER HAS BEEN READ * 01640000 * 1 FLAGDFN BIT(8), /* DFN STATEMENT FLAG BITS * 01650000 * 2 ADDRFLAG BIT(1), /* ADDR PARAMETER * 01660000 * 2 FOLDFLAG BIT(1); /* FOLD PARAMETER * 01670000 * DECLARE 01680000 * /* IF A FLAG BIT IS ON THAT FCB PARAMETER HAS BEEN READ * 01690000 * 1 FLAGFCB BIT(8), /* FCB STATEMENT FLAG BITS * 01700000 * 2 LPIFLAG BIT(1), /* LPI PARAMETER * 01710000 * 2 FEFLAG BIT(1), /* FE PARAMETER * 01720000 * 2 LNCHFLAG BIT(1); /* LNCH PARAMETER * 01730000 * DECLARE 01740000 * /* THE FOLLOWING CHARACTERS ARE USED TO ANALYZE THE JOB * 01750000 * /* CONTROL STATEMENTS * 01760000 * CJOB CHAR(3) INIT('JOB'), /* JOB STATEMENT HEADER * 01770000 * CDFN CHAR(3) INIT('DFN'), /* DFN STATEMENT HEADER * 01780000 * CUCS CHAR(3) INIT('UCS'), /* UCS STATEMENT HEADER * 01790000 * CFCB CHAR(3) INIT('FCB'), /* FCB STATEMENT HEADER * 01800000 * CEND CHAR(3) INIT('END'), /* END STATEMENT HEADER * 01810000 * CADDR CHAR(4) INIT('ADDR'), /* DFN STATEMENT PARAMETER * 01820000 * CFOLD CHAR(4) INIT('FOLD'), /* DFN STATEMENT PARAMETER * 01830000 * CY CHAR(1) INIT('Y'), /* FOLD PARAMETER OPTION * 01840000 * CN CHAR(1) INIT('N'), /* FOLD PARAMETER OPTION * 01850000 * CFORMEND CHAR(7) INIT('FORMEND'), /* FCB STATEMENT PARM * 01860000 * CLNCH CHAR(4) INIT('LNCH'), /* FCB STATEMENT PARAMETER * 01870000 * CLPI CHAR(3) INIT('LPI'), /* FCB STATEMENT PARAMETER * 01880000 * C6 CHAR(1) INIT('6'), /* LPI PARAMETER OPTION * 01890000 * C8 CHAR(1) INIT('8'), /* LPI PARAMETER OPTION * 01900000 * BLANK CHAR(1) INIT('40'X), /* PARAMETER END CODE * 01910000 * COMMA CHAR(1) INIT(','), /* PARAMETER DELIMETER * 01920000 * RPAREN CHAR(1) INIT(')'), /* END OF OPTION * 01930000 * LPAREN CHAR(1) INIT('('); /* START OF OPTION * 01940000 * DECLARE 01950000 * UCSSEQ BIT(8); /* UCS STATEMENT SEQUENCE NO * 01960000 * DECLARE 01970000 * MVLNTH BIT(8); /* MOVE-LENGTH OF FCB PARMS * 01980000 * DECLARE 01990000 * FCBSAVE POINTER(31), /* ADDRESS OF FIRST FCB PARM * 02000000 * JCLSTRT BASED(FCBSAVE); /* ADDRESSED BY JCLSTRT * 02010000 * DECLARE 02020000 * FCBJCL CHAR(300); /* FCB PARAMETER SAVE AREA * 02030000 * DECLARE 02040000 * LPI8 BIT(8) INIT('10'X); /* FLAG BIT FOR 8 LPI * 02050000 * DECLARE 02060000 * CNT FIXED(15); /* LIMIT OF CHECKING COLUMNS * 02070000 * DECLARE 02080000 * INAREA CHAR(80); /* CARD INPUT AREA * 02090000 * DECLARE 02100000 * CLRBYTE BIT(8) INIT('00'X); /* NULL BYTE FOR CLEARING * 02110000 * DECLARE 02120000 * NUM CHAR(16) INIT('0123456789ABCDEF'); /* VALID CHARACTERS * 02130000 * /* FOR PRINTER ADDR * 02140000 * DECLARE 02150000 * ENDBIT BIT(8) INIT('10'X); /* FLAG BIT FOR END-OF-FORM * 02160000 * DECLARE 02170000 * LNNO FIXED(31); /* FCB LINE NUMBER * 02180000 * DECLARE 02190000 * CHNO CHAR(4); /* FCB CHANNEL NUMBER * 02200000 * DECLARE 02210000 * TABLE CHAR(10) INIT('0123456789'); /* VALID CHARACTERS FOR * 02220000 * /* FCB LINE AND CHANNEL * 02230000 * /* NUMBERS * 02240000 * DECLARE 02250000 * DBWD CHAR(8) INIT('0000000000000000'X) BDY(DWORD); 02260000 * /* CONVERSION AREA FOR THE SUBROUTINE INTRP * 02270000 * DECLARE 02280000 * FWORD CHAR(4) BDY(WORD); /* CONVERSION AREA FOR THE * 02290000 * /* SUBROUTINE INTRP * 02300000 * DECLARE 02310000 * CR REGISTER(2) POINTER(31), /* POINTER TO INPUT AREA * 02320000 * COL BASED(CR) CHAR(7); /* ADDRESSED BY COL * 02330000 * DECLARE 02340000 * PR REGISTER(3) POINTER(31), /* POINTER TO UCS AND FCB * 02350000 * IMAGE BASED(PR) CHAR(56); /* ADDRESSED BY IMAGE * 02360000 * DECLARE 02370000 * WR REGISTER(4) POINTER(31), /* WORK REGISTER FOR INTRP * 02380000 * DTST BASED(WR); /* ADDRESSED BY DTST * 02390000 * DECLARE 02400000 * I FIXED(31); /* LENGTH OF LOOP ONE * 02410000 * DECLARE 02420000 * J FIXED(31); /* LENGTH OF LOOP TWO * 02430000 * DECLARE 02440000 * LENGTH FIXED(31); /* DATA LENGTH FOR INTRP * 02450000 * RESTRICT (12, /* GPR12 USED AS THE BASE * 02460000 * CR, /* POINTER TO INAREA * 02470000 * PR); /* POINTER TO IMAGE * 02480000 * /* * 02490000 * /* THE FOLLOWING IS USED TO GET A CARD, DETERMINE WHICH STATEMENT * 02500000 * /* IT IS, AND PASS CONTROL TO THE CORRESPONDING ROUTINE * 02510000 * /* * 02520000 * FLAG = FLAG & CLRBYTE; /* CLEAR FLAG BYTE * 02530000 NC FLAG(1),CLRBYTE 0065 02540000 * INPUT010: CALL GET; /* READ A CARD INTO INAREA * 02550000 INPUT010 BAL @E,GET 0066 02560000 * CR = ADDR(INAREA); /* SET UP POINTER TO INPUT * 02570000 LA @2,INAREA 0067 02580000 * CALL SEARCH; /* FIND FIRST BLANK * 02590000 BAL @E,SEARCH 0068 02600000 * CALL SEEK; /* FIND FIRST NON-BLANK * 02610000 BAL @E,SEEK 0069 02620000 * /* IF THIS CARD IS THE JOB STATEMENT BRANCH TO THE JOB CARD ROUTINE * 02630000 * IF COL(1:3) = CJOB /* IF THE OPERATION FIELD IS * 02640000 * THEN GO TO INPUT100; /* JOB GO TO INPUT100 * 02650000 CLC 0(3,@2),CJOB 0070 02660000 BC 08,INPUT100 0071 02670000 * /* IF THE JOB STATEMENT HAS NOT BEEN READ CANCEL THE UTILITY * 02680000 * IF JOBFLAG = '0'B /* IS THE JOB STATEMENT BIT ON* 02690000 * THEN /* YES - THE JOB CARD WAS READ* 02700000 TM FLAG,B'10000000' 0072 02710000 BC 05,@9FF 0072 02720000 * DO; /* CANCEL THE UTILITY * 02730000 * ERRCODE = CB03; /* INCORRECT JOB STATEMENT * 02740000 MVC ERRCODE(3),CB03 0074 02750000 * CALL WAIT; /* TERMINATE THE UTILITY * 02760000 BAL @E,WAIT 0075 02770000 * END; /* * 02780000 * /* IF THIS CARD IS THE DFN STATEMENT BRANCH TO THE DFN CARD ROUTINE * 02790000 * IF COL(1:3) = CDFN /* IF THE OPERATION FIELD IS * 02800000 * THEN GO TO INPUT200; /* DFN GO TO INPUT200 * 02810000 @9FF CLC 0(3,@2),CDFN 0077 02820000 BC 08,INPUT200 0078 02830000 * /* IF THIS CARD IS THE UCS STATEMENT BRANCH TO THE UCS CARD ROUTINE * 02840000 * IF COL(1:3) = CUCS /* IF THE OPERATION FIELD IS * 02850000 * THEN GO TO INPUT400; /* UCS GO TO INPUT400 * 02860000 CLC 0(3,@2),CUCS 0079 02870000 BC 08,INPUT400 0080 02880000 * /* IF THIS CARD IS THE FCB STATEMENT BRANCH TO THE FCB CARD ROUTINE * 02890000 * IF COL(1:3) = CFCB /* IF THE OPERATION FIELD IS * 02900000 * THEN GO TO INPUT600; /* FCB GO TO INPUT600 * 02910000 CLC 0(3,@2),CFCB 0081 02920000 BC 08,INPUT600 0082 02930000 * /* IF ALL STATEMENTS EXCEPT END HAVE NOT READ POST AN ERROR * 02940000 * IF FLAG = '1111'B /* IF ALL FLAGS NOT ON * 02950000 * THEN GO TO INPUT020; /* SET MISSING-CARD CODE * 02960000 TM FLAG,B'11110000' 0083 02970000 BC 12,INPUT020 0084 02980000 * /* IF THIS CARD IS NOT THE END STATEMENT POST AN ERROR * 02990000 * IF COL(1:3) = CEND /* IS OPERATION FIELD NOT END * 03000000 * THEN /* YES - THIS IS NOT END CARD * 03010000 CLC 0(3,@2),CEND 0085 03020000 BC 08,@9FE 0085 03030000 * DO; /* CANCEL THE UTILITY * 03040000 * ERRCODE = CB07; /* INCORRECT END STATEMENT * 03050000 MVC ERRCODE(3),CB07 0087 03060000 * CALL WAIT; /* TERMINATE THE UTILITY * 03070000 BAL @E,WAIT 0088 03080000 * END; /* * 03090000 * CALL CONTROL; /* LOAD THE BUFFERS * 03100000 @9FE BAL @E,CONTROL 0090 03110000 * INPUT020: ERRCODE = CB02; /* MISSING CONTROL CARD ERROR * 03120000 INPUT020 MVC ERRCODE(3),CB02 0091 03130000 * CALL WAIT; /* TERMINATE THE UTILITY * 03140000 BAL @E,WAIT 0092 03150000 * /* * 03160000 * /* JOB STATEMENT ROUTINE * 03170000 * /* * 03180000 * /* IF ANOTHER STATEMENT HAS ALREADY BEEN READ POST AN ERROR * 03190000 * INPUT100: IF FLAG = '0000'B /* IF ALL FLAGS NOT OFF * 03200000 * THEN GO TO INPUT020; /* SET MISSING-CARD CODE * 03210000 INPUT100 TM FLAG,B'11110000' 0093 03220000 BC 05,INPUT020 0094 03230000 * JOBFLAG = '1'B; /* INDICATE JOB STATEMENT READ* 03240000 OI FLAG,B'10000000' 0095 03250000 * GO TO INPUT010; /* READ ANOTHER CARD * 03260000 BC 15,INPUT010 0096 03270000 * /* * 03280000 * /* DFN STATEMENT ROUTINE * 03290000 * /* * 03300000 * /* IF THE DFN STATEMENT HAS ALREADY BEEN READ POST AN ERROR * 03310000 * INPUT200: IF DFNFLAG = '1'B /* IS THE DFN STATEMENT BIT ON* 03320000 * THEN GO TO INPUT020; /* YES - SET ERROR CODE * 03330000 INPUT200 TM FLAG,B'00010000' 0097 03340000 BC 01,INPUT020 0098 03350000 * DFNFLAG = '1'B; /* INDICATE DFN STATEMENT READ* 03360000 OI FLAG,B'00010000' 0099 03370000 * FLAGDFN = FLAGDFN & CLRBYTE; /* CLEAR FLAG FOR DFN CARD * 03380000 NC FLAGDFN(1),CLRBYTE 0100 03390000 * CALL SEARCH; /* POINT BEYOND OPERATION FLD * 03400000 BAL @E,SEARCH 0101 03410000 * CALL SEEK; /* POINT TO PARAMETER START * 03420000 BAL @E,SEEK 0102 03430000 * /* IF THIS IS THE ADDR PARAMETER GO TO THE ADDR HANDLER * 03440000 * INPUT210: IF COL(1:4) = CADDR /* IF THE OPERAND FIELD IS * 03450000 * THEN GO TO INPUT230; /* ADDR GO TO INPUT230 * 03460000 INPUT210 CLC 0(4,@2),CADDR 0103 03470000 BC 08,INPUT230 0104 03480000 * /* IF THIS IS THE FOLD PARAMETER GO TO THE FOLD HANDLER * 03490000 * IF COL(1:4) = CFOLD /* IF THE OPERAND FIELD IS * 03500000 * THEN GO TO INPUT250; /* FOLD GO TO INPUT250 * 03510000 CLC 0(4,@2),CFOLD 0105 03520000 BC 08,INPUT250 0106 03530000 * INPUT220: ERRCODE = CB04; /* INCORRECT DFN STATEMENT * 03540000 INPUT220 MVC ERRCODE(3),CB04 0107 03550000 * CALL WAIT; /* TERMINATE THE UTILITY * 03560000 BAL @E,WAIT 0108 03570000 * /* IF THE ADDR PARAMETER HAS ALREADY BEEN READ SET AN ERROR CODE * 03580000 * INPUT230: IF ADDRFLAG = '1'B /* IS THE ADDR PARM BIT ON * 03590000 * THEN GO TO INPUT220; /* YES - SET ERROR CODE * 03600000 INPUT230 TM FLAGDFN,B'10000000' 0109 03610000 BC 01,INPUT220 0110 03620000 * ADDRFLAG = '1'B; /* INDICATE ADDR PARM READ * 03630000 OI FLAGDFN,B'10000000' 0111 03640000 * CR = CR + 5; /* POINT TO PRINTER ADDRESS * 03650000 AH @2,@D1 0112 03660000 * /* CHECK THE USER DEFINED PRINTER ADDRESS BY COMPARING EACH * 03670000 * /* CHARACTER WITH A LIST OF VALID CHARACTERS * 03680000 * DO I = 1 TO 3; /* CHECK THE NEXT THREE CHARS * 03690000 LA @F,1 0113 03700000 ST @F,I 0113 03710000 * DO J = 1 TO 16; /* COMARE THEM TO VALID CHARS * 03720000 @DO9FD LA @F,1 0114 03730000 ST @F,J 0114 03740000 * /* IF THE CHARACTER IS VALID GO TO CHECK THE NEXT ONE * 03750000 * IF COL(I) = NUM(J) /* IF THE CHARACTER IS VALID * 03760000 * THEN GO TO INPUT240; /* END THE COMPARISON * 03770000 @DO9F9 L @1,J 0115 03780000 LA @E,NUM-1(@1) 0115 03790000 L @B,I 0115 03800000 LA @A,0(@B,@2) 0115 03810000 BCTR @A,0 0115 03820000 CLC 0(1,@A),0(@E) 0115 03830000 BC 08,INPUT240 0116 03840000 * END; /* * 03850000 * GO TO INPUT220; /* IF NOT VALID SET ERROR CODE* 03860000 L @F,J 0117 03870000 AH @F,@D2 0117 03880000 @DO9F8 ST @F,J 0117 03890000 CH @F,@D3 0117 03900000 BC 12,@DO9F9 0117 03910000 BC 15,INPUT220 0118 03920000 * INPUT240: ; /* * 03930000 * END; /* * 03940000 * PTRADDR = COL; /* SAVE THE PRINTER ADDRESS * 03950000 INPUT240 L @F,I 0120 03960000 AH @F,@D2 0120 03970000 @DO9FC ST @F,I 0120 03980000 CH @F,@D4 0120 03990000 BC 12,@DO9FD 0120 04000000 MVC PTRADDR(3),0(@2) 0121 04010000 * CR = CR + 3; /* POINT BEYOND ADDRESS * 04020000 AH @2,@D4 0122 04030000 * GO TO INPUT270; /* CHECK FOR MORE PARAMETERS * 04040000 BC 15,INPUT270 0123 04050000 * /* IF THE FOLD PARAMETER HAS ALREADY BEEN READ SET AN ERROR CODE * 04060000 * INPUT250: IF FOLDFLAG = '1'B /* IS THE FOLD PARM BIT ON * 04070000 * THEN GO TO INPUT220; /* YES - SET ERROR CODE * 04080000 INPUT250 TM FLAGDFN,B'01000000' 0124 04090000 BC 01,INPUT220 0125 04100000 * FOLDFLAG = '1'B; /* INDICATE FOLD PARM READ * 04110000 OI FLAGDFN,B'01000000' 0126 04120000 * CR = CR + 5; /* POINT TO FOLD OPTION * 04130000 AH @2,@D1 0127 04140000 * /* IF THE USER SPECIFIES Y (YES-FOLD) TURN THE FOLDBIT ON * 04150000 * IF COL(1) = CY /* IF THE OPTION IS Y * 04160000 * THEN DO; /* THE USER IS REQUEST FOLD* 04170000 CLC 0(1,@2),CY 0128 04180000 BC 07,@9F5 0128 04190000 * FOLDBIT = '00000001'B; /* INDICATE FOLD CCW ISSUED * 04200000 MVI FOLDBIT,B'00000001' 0130 04210000 * GO TO INPUT260; /* POINT TO NEXT PARAMETER * 04220000 BC 15,INPUT260 0131 04230000 * END; /* * 04240000 * /* IF THE USER SPECIFIES N (NO-DONT FOLD) CONTINUE * 04250000 * IF COL(1) = CN /* IF THE OPTION IS N * 04260000 * THEN GO TO INPUT260; /* POINT TO NEXT PARM * 04270000 @9F5 CLC 0(1,@2),CN 0133 04280000 * GO TO INPUT220; /* OPTION NOT VALID - ERROR * 04290000 BC 07,INPUT220 0135 04300000 * INPUT260: CR = CR + 1; /* POINT TO THE NEXT PARM * 04310000 INPUT260 AH @2,@D2 0136 04320000 * /* IF BOTH DFN PARAMETERS HAVE BEEN READ GO ON TO THE NEXT STATEMENT* 04330000 * INPUT270: IF FLAGDFN = '11'B /* IF BOTH PARM FLAG BITS ARE * 04340000 * THEN GO TO INPUT010; /* ON READ ANOTHER CARD * 04350000 INPUT270 TM FLAGDFN,B'11000000' 0137 04360000 BC 01,INPUT010 0138 04370000 * /* IF THERE ARE NO MORE PARAMETERS IN THE DFN STATEMENT SET AN ERROR* 04380000 * IF COL(1) = COMMA /* IF THIS COLUMN IS NOT A * 04390000 * THEN GO TO INPUT220; /* COMMA SET AN ERROR CODE * 04400000 CLC 0(1,@2),COMMA 0139 04410000 BC 07,INPUT220 0140 04420000 * CR = CR + 1; /* POINT TO NEXT PARAMETER * 04430000 AH @2,@D2 0141 04440000 * /* IF THIS IS THE START OF THE NEXT PARM GO TO PROCESS IT * 04450000 * IF COL(1) = BLANK /* IF THIS COLUMN IS NOT * 04460000 * THEN GO TO INPUT210; /* BLANK GO TO INPUT210 * 04470000 CLC 0(1,@2),BLANK 0142 04480000 BC 07,INPUT210 0143 04490000 * /* IF THERE IS NOT CONTINUATION CHARACTER SET AN ERROR CODE * 04500000 * IF INAREA(72) = BLANK /* IF DFN STATEMENT IS NOT * 04510000 * THEN GO TO INPUT220; /* CONTINUED SET ERROR CODE* 04520000 CLC INAREA+71(1),BLANK 0144 04530000 BC 08,INPUT220 0145 04540000 * CALL GET; /* READ NEXT DFN CARD * 04550000 BAL @E,GET 0146 04560000 * CR = ADDR(INAREA); /* POINT TO START OF INPUT * 04570000 LA @2,INAREA 0147 04580000 * CALL SEEK; /* FIND THE FIRST NON-BLANK * 04590000 BAL @E,SEEK 0148 04600000 * GO TO INPUT210; /* PROCESS THE NEXT PARAMETER * 04610000 BC 15,INPUT210 0149 04620000 * /* * 04630000 * /* UCS STATEMENT ROUTINE * 04640000 * /* * 04650000 * /* IF THE UCS STATEMENT HAS ALREADY BEEN READ POST AN ERROR * 04660000 * INPUT400: IF UCSFLAG = '1'B /* IS THE UCS STATEMENT BIT ON* 04670000 * THEN GO TO INPUT020; /* YES - SET ERROR CODE * 04680000 INPUT400 TM FLAG,B'01000000' 0150 04690000 BC 01,INPUT020 0151 04700000 * UCSFLAG = '1'B; /* INDICATE UCS STATEMENT READ* 04710000 OI FLAG,B'01000000' 0152 04720000 * /* SAVE UP TO EIGHT CHARACTERS OF THE UCS NAME * 04730000 * DO I = 1 TO 8; /* SET LIMIT OF LOOP TO EIGHT * 04740000 LA @F,1 0153 04750000 ST @F,I 0153 04760000 * /* IF ALL CHARACTERS OF THE NAME HAVE BEEN READ END THE LOOP * 04770000 * IF INAREA(I) = BLANK /* IF THIS IS LAST CHARACTER * 04780000 * THEN GO TO INPUT420; /* END THE LOOP * 04790000 @DO9F4 L @1,I 0154 04800000 LA @A,INAREA-1(@1) 0154 04810000 CLC 0(1,@A),BLANK 0154 04820000 BC 08,INPUT420 0155 04830000 * ELSE UCSNMST(I) = INAREA(I); /* ELSE SAVE CHARACTER* 04840000 LA @E,INAREA-1(@1) 0156 04850000 LA @A,UCSNMST-1(@1) 0156 04860000 MVC 0(1,@A),0(@E) 0156 04870000 * END; /* * 04880000 * INPUT420: UCSSEQ = '00000001'B; /* SET SEQUENCE NUMBER TO 1 * 04890000 L @F,I 0157 04900000 AH @F,@D2 0157 04910000 @DO9F3 ST @F,I 0157 04920000 CH @F,@D5 0157 04930000 BC 12,@DO9F4 0157 04940000 INPUT420 MVI UCSSEQ,B'00000001' 0158 04950000 * PR = ADDR(UCSLOAD); /* LOAD UCS IMAGE ADDRESS * 04960000 LA @3,UCSLOAD 0159 04970000 * /* CHECK FOR THE EIGTH UCS CARD - IF YES LOAD 40 CHARACTERS * 04980000 * INPUT450: IF UCSSEQ = '00001000'B /* IS THIS THE EIGTH CARD * 04990000 * THEN DO; /* YES - LOAD 40 CHARACTERS * 05000000 INPUT450 CLI UCSSEQ,B'00001000' 0160 05010000 BC 07,@9F0 0160 05020000 * DO I = 1 TO 40; /* SET LIMIT TO 40 * 05030000 LA @F,1 0162 05040000 ST @F,I 0162 05050000 * IMAGE(I) = INAREA(I + 15); /* MOVE CHARACTERS * 05060000 @DO9EF LA @1,15 0163 05070000 A @1,I 0163 05080000 LA @E,INAREA-1(@1) 0163 05090000 L @B,I 0163 05100000 LA @A,0(@B,@3) 0163 05110000 BCTR @A,0 0163 05120000 MVC 0(1,@A),0(@E) 0163 05130000 * END; /* * 05140000 * GO TO INPUT010; /* READ ANOTHER DATA CARD * 05150000 L @F,I 0164 05160000 AH @F,@D2 0164 05170000 @DO9EE ST @F,I 0164 05180000 CH @F,@D6 0164 05190000 BC 12,@DO9EF 0164 05200000 BC 15,INPUT010 0165 05210000 * END; /* * 05220000 * ELSE DO; /* NO - LOAD 56 CHARACTERS * 05230000 * DO I = 1 TO 56; /* SET LIMIT TO 56 * 05240000 @9F0 LA @F,1 0168 05250000 ST @F,I 0168 05260000 * IMAGE(I) = INAREA(I + 15); /* MOVE CHARACTERS * 05270000 @DO9EA LA @1,15 0169 05280000 A @1,I 0169 05290000 LA @E,INAREA-1(@1) 0169 05300000 L @B,I 0169 05310000 LA @A,0(@B,@3) 0169 05320000 BCTR @A,0 0169 05330000 MVC 0(1,@A),0(@E) 0169 05340000 * END; /* * 05350000 * PR = PR + 56; /* INCREASE POINTER BY 56 * 05360000 L @F,I 0170 05370000 AH @F,@D2 0170 05380000 @DO9E9 ST @F,I 0170 05390000 CH @F,@D7 0170 05400000 BC 12,@DO9EA 0170 05410000 AH @3,@D7 0171 05420000 * UCSSEQ = UCSSEQ + 1; /* INCREASE SEQUENCE BY 1 * 05430000 LA @F,1 0172 05440000 SR @0,@0 0172 05450000 IC @0,UCSSEQ 0172 05460000 AR @F,@0 0172 05470000 STC @F,UCSSEQ 0172 05480000 * CALL GET; /* READ ANOTHER UCS DATA CARD * 05490000 BAL @E,GET 0173 05500000 * /* IF ANY COLUMN FROM 1 TO 15 CONTAINS A NON-BLANK THIS IS NOT A * 05510000 * /* CORRECT UCS STATEMENT * 05520000 * DO I = 1 TO 15; /* SET LIMIT TO 15 * 05530000 LA @F,1 0174 05540000 ST @F,I 0174 05550000 * /* IF THIS COLUMN IS A NON-BLANK SET AN ERROR CODE * 05560000 * IF INAREA(I) = BLANK /* IF COLUMN I IS A BLANK * 05570000 * THEN DO; /* THEN TERMINATE * 05580000 @DO9E6 L @1,I 0175 05590000 LA @A,INAREA-1(@1) 0175 05600000 CLC 0(1,@A),BLANK 0175 05610000 BC 08,@9E2 0175 05620000 * ERRCODE = CB05; /* INCORRECT UCS STATEMENT * 05630000 MVC ERRCODE(3),CB05 0177 05640000 * CALL WAIT; /* TERMINATE THE UTILITY * 05650000 BAL @E,WAIT 0178 05660000 * END; /* * 05670000 * END; /* * 05680000 * GO TO INPUT450; /* ANALYZE THIS UCS CARD * 05690000 @9E2 L @F,I 0180 05700000 AH @F,@D2 0180 05710000 @DO9E5 ST @F,I 0180 05720000 CH @F,@D8 0180 05730000 BC 12,@DO9E6 0180 05740000 BC 15,INPUT450 0181 05750000 * END; /* * 05760000 * /* * 05770000 * /* FCB STATEMENT ROUTINE * 05780000 * /* * 05790000 * /* IF THE FCB STATEMENT HAS ALREADY BEEN READ POST AN ERROR * 05800000 * INPUT600: IF FCBFLAG = '1'B /* IS THE FCB STATEMENT BIT ON* 05810000 * THEN GO TO INPUT020; /* YES - SET ERROR CODE * 05820000 @9EB EQU * 0183 05830000 INPUT600 TM FLAG,B'00100000' 0183 05840000 BC 01,INPUT020 0184 05850000 * FCBFLAG = '1'B; /* INDICATE FCB STATEMENT READ* 05860000 OI FLAG,B'00100000' 0185 05870000 * /* SAVE UP TO EIGHT CHARACTERS OF THE FCB NAME * 05880000 * DO I = 1 TO 8; /* SET LIMIT OF LOOP TO EIGHT * 05890000 LA @F,1 0186 05900000 ST @F,I 0186 05910000 * /* IF ALL CHARACTERS OF THE NAME HAVE BEEN READ END THE LOOP * 05920000 * IF INAREA(I) = BLANK /* IF THIS IS THE LAST CHAR * 05930000 * THEN GO TO INPUT605; /* END THE LOOP * 05940000 @DO9E1 L @1,I 0187 05950000 LA @A,INAREA-1(@1) 0187 05960000 CLC 0(1,@A),BLANK 0187 05970000 BC 08,INPUT605 0188 05980000 * ELSE FCBNMST(I) = INAREA(I); /* ELSE SAVE CHARACTER* 05990000 LA @E,INAREA-1(@1) 0189 06000000 LA @A,FCBNMST-1(@1) 0189 06010000 MVC 0(1,@A),0(@E) 0189 06020000 * END; /* * 06030000 * INPUT605: PR = ADDR(FCBJCL); /* POINT TO JCL SAVE AREA * 06040000 L @F,I 0190 06050000 AH @F,@D2 0190 06060000 @DO9E0 ST @F,I 0190 06070000 CH @F,@D5 0190 06080000 BC 12,@DO9E1 0190 06090000 INPUT605 LA @3,FCBJCL 0191 06100000 * /* * 06110000 * /* ALL FCB STATEMENT CARDS ARE READ IN AND THE OPERANDS SAVED AT * 06120000 * /* FCBJCL * 06130000 * /* * 06140000 * INPUT610: CALL SEARCH; /* FIND THE FIRST BLANK * 06150000 INPUT610 BAL @E,SEARCH 0192 06160000 * CALL SEEK; /* FIND THE FIRST NON-BLANK * 06170000 BAL @E,SEEK 0193 06180000 * FCBSAVE = CR; /* SAVE FIRST PARM ADDRESS * 06190000 ST @2,FCBSAVE 0194 06200000 * /* IF THIS IS THE LAST FCB CARD MOVE IT TO FCBJCL AND PROCESS IT * 06210000 * IF INAREA(72) = BLANK /* IF CONTINUATION COL BLANK * 06220000 * THEN GO TO INPUT650; /* HANDLE AS LAST CARD * 06230000 CLC INAREA+71(1),BLANK 0195 06240000 BC 08,INPUT650 0196 06250000 * CALL SEARCH; /* FIND THE FIRST BLANK * 06260000 BAL @E,SEARCH 0197 06270000 * /* IF THE FIRST BLANK IS BEYOND COL 71 THEN THE LENGTH OF THE MOVE * 06280000 * /* MUST BE REDUCED BY ONE FOR THE CONTINUATION CHARACTER * 06290000 * IF CR > ADDR(INAREA) + 71 /* FIRST BLANK BEYOND COL 71? * 06300000 * THEN DO; /* YES - REDUCE LENGTH BY ONE * 06310000 LA @F,71 0198 06320000 LA @0,INAREA 0198 06330000 AR @F,@0 0198 06340000 CR @F,@2 0198 06350000 BC 10,@9DD 0198 06360000 * MVLNTH = ADDR(INAREA) + 71 - FCBSAVE; /* DEFINE LENGTH* 06370000 L @F,FCBSAVE 0200 06380000 LCR @F,@F 0200 06390000 AH @F,@D9 0200 06400000 LA @0,INAREA 0200 06410000 AR @F,@0 0200 06420000 STC @F,MVLNTH 0200 06430000 * GO TO INPUT620; /* SAVE CARD AT FCBJCL * 06440000 BC 15,INPUT620 0201 06450000 * END; /* * 06460000 * CR = CR - 1; /* POINT TO COL BEFORE BLANK * 06470000 @9DD BCTR @2,0 0203 06480000 * /* COLUMN BEFORE THE BLANK MUST BE A COMMA OR THERE IS AN ERROR * 06490000 * IF COL(1) = COMMA /* IF COL IS NOT A COMMA * 06500000 * THEN GO TO INPUT640; /* SET AN ERROR CODE * 06510000 CLC 0(1,@2),COMMA 0204 06520000 BC 07,INPUT640 0205 06530000 * MVLNTH = CR - FCBSAVE + 1; /* SET LENGTH OF MOVE * 06540000 LA @F,1 0206 06550000 S @F,FCBSAVE 0206 06560000 AR @F,@2 0206 06570000 STC @F,MVLNTH 0206 06580000 * INPUT620: IMAGE(1:MVLNTH) = JCLSTRT; /* MOVE CARD TO JCL SAVEAREA * 06590000 INPUT620 L @1,FCBSAVE 0207 06600000 LR @E,@1 0207 06610000 SR @B,@B 0207 06620000 IC @B,MVLNTH 0207 06630000 BCTR @B,0 0207 06640000 LR @A,@3 0207 06650000 EX @B,@MVC 0207 06660000 * PR = PR + MVLNTH; /* INCREASE SAVEAREA POINTER * 06670000 SR @0,@0 0208 06680000 IC @0,MVLNTH 0208 06690000 AR @3,@0 0208 06700000 * CALL GET; /* READ ANOTHER DATA CARD * 06710000 BAL @E,GET 0209 06720000 * CR = ADDR(INAREA); /* LOAD ADDRESS OF COL ONE * 06730000 LA @2,INAREA 0210 06740000 * /* IF ANY COLUMN FROM 1 TO 15 CONTAINS A NON-BLANK THIS IS NOT A * 06750000 * /* CORRECT FCB STATEMENT * 06760000 * DO I = 1 TO 15; /* SET LIMIT TO 15 * 06770000 LA @F,1 0211 06780000 ST @F,I 0211 06790000 * /* IF THIS COLUMN IS A NON-BLANK SET AN ERROR CODE * 06800000 * IF INAREA(I) = BLANK /* IF COLUMN I IS A BLANK * 06810000 * THEN GO TO INPUT640; /* THEN TERMINATE * 06820000 @DO9DC L @1,I 0212 06830000 LA @A,INAREA-1(@1) 0212 06840000 CLC 0(1,@A),BLANK 0212 06850000 BC 07,INPUT640 0213 06860000 * END; /* * 06870000 * GO TO INPUT610; /* CHECK DATA ON THIS CARD * 06880000 L @F,I 0214 06890000 AH @F,@D2 0214 06900000 @DO9DB ST @F,I 0214 06910000 CH @F,@D8 0214 06920000 BC 12,@DO9DC 0214 06930000 BC 15,INPUT610 0215 06940000 * INPUT640: ERRCODE = CB06; /* INCORRECT FCB STATEMENT * 06950000 INPUT640 MVC ERRCODE(3),CB06 0216 06960000 * CALL WAIT; /* TERMINATE THE UTILITY * 06970000 BAL @E,WAIT 0217 06980000 * INPUT650: CALL SEARCH; /* FIND THE FIRST BLANK * 06990000 INPUT650 BAL @E,SEARCH 0218 07000000 * MVLNTH = CR - FCBSAVE; /* SET LENGTH OF MOVE * 07010000 LR @F,@2 0219 07020000 S @F,FCBSAVE 0219 07030000 STC @F,MVLNTH 0219 07040000 * IMAGE(1:MVLNTH) = JCLSTRT; /* MOVE CARD TO JCL SAVEAREA * 07050000 L @1,FCBSAVE 0220 07060000 LR @E,@1 0220 07070000 SR @B,@B 0220 07080000 IC @B,MVLNTH 0220 07090000 BCTR @B,0 0220 07100000 LR @A,@3 0220 07110000 EX @B,@MVC 0220 07120000 * PR = PR + MVLNTH; /* INCREASE SAVEAREA POINTER * 07130000 SR @0,@0 0221 07140000 IC @0,MVLNTH 0221 07150000 AR @3,@0 0221 07160000 * /* * 07170000 * /* THE FCB OPERANDS ARE ANALYZED TO FORM THE FCB IMAGE * 07180000 * /* * 07190000 * FLAGFCB = '00000000'B; /* CLEAR FLAG FOR FCB CARD * 07200000 MVI FLAGFCB,B'00000000' 0222 07210000 * CR = ADDR(FCBJCL); /* POINT TO FIRST PARAMETER * 07220000 LA @2,FCBJCL 0223 07230000 * /* IF ALL OF THE FCB PARAMETERS HAVE BEEN READ GET ANOTHER STATEMENT* 07240000 * INPUT660: IF FLAGFCB = '111'B /* IF ALL FCB FLAGS ON * 07250000 * THEN GO TO INPUT010; /* READ ANOTHER JCL CARD * 07260000 INPUT660 TM FLAGFCB,B'11100000' 0224 07270000 BC 01,INPUT010 0225 07280000 * /* IF THIS PARM IS LPI GO TO THE LPI ROUTINE * 07290000 * IF COL(1:3) = CLPI /* IF COL HAS LPI CHARACTERS * 07300000 * THEN GO TO INPUT670; /* GO TO LPI ROUTINE * 07310000 CLC 0(3,@2),CLPI 0226 07320000 BC 08,INPUT670 0227 07330000 * /* IF THIS PARM IS FORMEND GO TO THE FORMEND ROUTINE * 07340000 * IF COL(1:7) = CFORMEND /* IF COL HAS FORMEND CHARS * 07350000 * THEN GO TO INPUT700; /* GO TO FORMEND ROUTINE * 07360000 CLC 0(7,@2),CFORMEND 0228 07370000 BC 08,INPUT700 0229 07380000 * /* IF THIS PARM IS LNCH GO TO THE LNCH ROUTINE * 07390000 * IF COL(1:4) = CLNCH /* IF COL HAS LNCH CHARACTERS * 07400000 * THEN GO TO INPUT720; /* GO TO LNCH ROUTINE * 07410000 CLC 0(4,@2),CLNCH 0230 07420000 BC 08,INPUT720 0231 07430000 * GO TO INPUT680; /* SET INCORRECT FCB CODE * 07440000 BC 15,INPUT680 0232 07450000 * /* IF THE LPI PARAMETER HAS ALREADY BEEN READ SET INCORRECT FCB CODE* 07460000 * INPUT670: IF LPIFLAG = '1'B /* IF LPI FLAG IS ON * 07470000 * THEN GO TO INPUT680; /* SET AN ERROR CODE * 07480000 INPUT670 TM FLAGFCB,B'10000000' 0233 07490000 BC 01,INPUT680 0234 07500000 * LPIFLAG = '1'B; /* INDICATE LPI PARM READ * 07510000 OI FLAGFCB,B'10000000' 0235 07520000 * CR = CR + 4; /* POINT TO LPI OPTION * 07530000 AH @2,@D10 0236 07540000 * /* IF THE USER HAS SPECIFIED 6 LINES PER INCH DO NOT SET LPI BIT ON * 07550000 * IF COL(1) = C6 /* IF THE OPTION IS 6 * 07560000 * THEN DO; /* THEN CONTINUE * 07570000 CLC 0(1,@2),C6 0237 07580000 BC 07,@9D8 0237 07590000 * CR = CR + 2; /* POINT TO THE NEXT PARM * 07600000 AH @2,@D11 0239 07610000 * GO TO INPUT660; /* ANALYZE THE NEXT PARM * 07620000 BC 15,INPUT660 0240 07630000 * END; /* * 07640000 * /* IF THE USER HAS SPECIFIED 8 LINES PER INCH SET THE LPI BIT ON * 07650000 * IF COL(1) = C8 /* IF THE OPTION IS 8 * 07660000 * THEN DO; /* THEN SET FLAG & CONTINUE* 07670000 @9D8 CLC 0(1,@2),C8 0242 07680000 BC 07,@9D7 0242 07690000 * FCBIMG(1) = FCBIMG(1) LPI8; /* SET LPI BIT ON IN FCB* 07700000 OC FCBIMG(1),LPI8 0244 07710000 * CR = CR + 2; /* POINT TO THE NEXT PARM * 07720000 AH @2,@D11 0245 07730000 * GO TO INPUT660; /* ANALYZE THE NEXT PARM * 07740000 BC 15,INPUT660 0246 07750000 * END; /* * 07760000 * INPUT680: ERRCODE = CB06; /* INCORRECT FCB STATEMENT * 07770000 @9D7 EQU * 0248 07780000 INPUT680 MVC ERRCODE(3),CB06 0248 07790000 * CALL WAIT; /* TERMINATE THE UTILITY * 07800000 BAL @E,WAIT 0249 07810000 * /* IF THE FORMEND PARAMETER HAS ALREADY BEEN READ SET AN ERROR CODE * 07820000 * INPUT700: IF FEFLAG = '1'B /* IF FORMEND FLAG IS ON * 07830000 * THEN GO TO INPUT680; /* SET AN ERROR CODE * 07840000 INPUT700 TM FLAGFCB,B'01000000' 0250 07850000 BC 01,INPUT680 0251 07860000 * FEFLAG = '1'B; /* INDICATE FORMEND PARM READ * 07870000 OI FLAGFCB,B'01000000' 0252 07880000 * CR = CR + 8; /* POINT TO THE FORMEND OPTION* 07890000 AH @2,@D5 0253 07900000 * CALL INTRP; /* INTERPRET DECIMAL DIGITS * 07910000 BAL @E,INTRP 0254 07920000 * /* IF THE LINE FOR END-OF-FORM IS BEYOND 180 SET AN ERROR CODE * 07930000 * IF PR > 180 /* IF FORMEND EXCEEDS LIMIT * 07940000 * THEN GO TO INPUT680; /* SET AN ERROR CODE * 07950000 CH @3,@D12 0255 07960000 BC 02,INPUT680 0256 07970000 * FCBIMG(PR) = FCBIMG(PR) ENDBIT; /* SET END OF FORM BIT ON * 07980000 LR @1,@3 0257 07990000 LA @A,FCBIMG-1(@1) 0257 08000000 OC 0(1,@A),ENDBIT 0257 08010000 * CR = CR + 1; /* POINT TO THE NEXT PARM * 08020000 AH @2,@D2 0258 08030000 * GO TO INPUT660; /* ANALYZE THE NEXT PARM * 08040000 BC 15,INPUT660 0259 08050000 * /* IF THE LNCH PARAMETER HAS ALREADY BEEN READ SET AN ERROR CODE * 08060000 * INPUT720: IF LNCHFLAG = '1'B /* IF LNCH BIT IS ON * 08070000 * THEN GO TO INPUT680; /* SET AN ERROR CODE * 08080000 INPUT720 TM FLAGFCB,B'00100000' 0260 08090000 BC 01,INPUT680 0261 08100000 * LNCHFLAG = '1'B; /* INDICATE LNCH PARM READ * 08110000 OI FLAGFCB,B'00100000' 0262 08120000 * CR = CR + 6; /* POINT TO THE LNCH OPTIONS * 08130000 AH @2,@D13 0263 08140000 * /* IF ALL PAIRS OF LINES AND CHANNELS HAVE BEEN READ CHECK NEXT PARM* 08150000 * INPUT730: IF COL(1) = RPAREN /* IF THE ENDING CHAR - ')' * 08160000 * THEN DO; /* CHECK THE NEXT PARAMETER* 08170000 INPUT730 CLC 0(1,@2),RPAREN 0264 08180000 BC 07,@9D6 0264 08190000 * CR = CR + 2; /* POINT TO NEXT PARAMETER * 08200000 AH @2,@D11 0266 08210000 * GO TO INPUT660; /* ANALYZE NEXT PAREMETER * 08220000 BC 15,INPUT660 0267 08230000 * END; /* * 08240000 * /* IF THIS IS NOT THE START OF THE NEXT PAIR SET AN ERROR * 08250000 * IF COL(1) = LPAREN /* IF NOT A '(' * 08260000 * THEN GO TO INPUT680; /* SET AN ERROR CODE * 08270000 @9D6 CLC 0(1,@2),LPAREN 0269 08280000 BC 07,INPUT680 0270 08290000 * CR = CR + 1; /* POINT TO LINE NUMBER * 08300000 AH @2,@D2 0271 08310000 * CALL INTRP; /* INTERPRET DECIMAL DIGITS * 08320000 BAL @E,INTRP 0272 08330000 * /* IF THE LINE NUMBER IS BEYOND 180 SET AN ERROR CODE * 08340000 * IF PR > 180 /* IF LINE EXCEEDS LIMIT * 08350000 * THEN GO TO INPUT680; /* SET AN ERROR CODE * 08360000 CH @3,@D12 0273 08370000 BC 02,INPUT680 0274 08380000 * LNNO = PR; /* SAVE THE LINE NUMBER * 08390000 ST @3,LNNO 0275 08400000 * CR = CR + 1; /* POINT TO CHANNEL NUMBER * 08410000 AH @2,@D2 0276 08420000 * CALL INTRP; /* INTERPRET DECIMAL DIGITS * 08430000 BAL @E,INTRP 0277 08440000 * /* IF THE CHANNEL NUMBER IS BEYOND 12 SET AN ERROR CODE * 08450000 * IF PR > 12 /* IF CHANNEL EXCEEDS LIMIT * 08460000 * THEN GO TO INPUT680; /* SET AN ERROR CODE * 08470000 CH @3,@D14 0278 08480000 BC 02,INPUT680 0279 08490000 * CHNO = PR; /* SAVE THE CHANNEL NUMBER * 08500000 ST @3,CHNO 0280 08510000 * FCBIMG(LNNO) = FCBIMG(LNNO) CHNO(4); /* SET CHANNEL DEF * 08520000 L @1,LNNO 0281 08530000 LA @A,FCBIMG-1(@1) 0281 08540000 OC 0(1,@A),CHNO+3 0281 08550000 * CR = CR + 1; /* POINT TO NEXT CHARACTER * 08560000 AH @2,@D2 0282 08570000 * /* IF THERE ARE MORE PAIRS POINT TO THE NEXT ONE * 08580000 * IF COL(1) = COMMA /* IF A COMMA AT THIS CHAR * 08590000 * THEN CR = CR + 1; /* INCREASE POINTER * 08600000 CLC 0(1,@2),COMMA 0283 08610000 BC 07,@9D5 0283 08620000 AH @2,@D2 0284 08630000 * GO TO INPUT730; /* ANALYZE THE NEXT PAIR * 08640000 BC 15,INPUT730 0285 08650000 * /* * 08660000 * /* THE FOLLOWING ROUTINE IS USED TO INTERPRET DECIMAL DATA AND * 08670000 * /* RETURN WITH THE DATA IN HEX FORM. * 08680000 * /* * 08690000 * INTRP: PROCEDURE /* INTERPRET ROUTINE * 08700000 * OPTIONS(NOSAVEAREA, /* SAVEAREA IS NOT REQUIRED * 08710000 * DONTSAVE(2,3,4)); /* PARAMETER REGISTERS * 08720000 @EL03 L @D,4(0,@D) 0286 08730000 LM @E,@C,12(@D) 0286 08740000 BCR 15,@E 0286 08750000 INTRP STM @E,@1,12(@D) 0286 08760000 STM @5,@C,40(@D) 0286 08770000 * RESTRICT (CR, /* DATA TO BE INTERPRETED * 08780000 * PR, /* HEX EQUIVALENT OF DATA * 08790000 * WR, /* STARTING ADDRESS OF DATA * 08800000 * 12); /* GPR12 USED AS THE BASE * 08810000 * WR = CR; /* SAVE DATA STARTING ADDRESS * 08820000 LR @4,@2 0288 08830000 * /* CHECK ALL DIGITS OF THE DATA FIELD FOR NUMERALS BY COMPARING THEM* 08840000 * /* TO A LIST OF ALL POSSIBLE NUMERIC VALUES * 08850000 * DO I = 1 TO 3; /* COMPARE UP TO THREE DIGITS * 08860000 LA @F,1 0289 08870000 ST @F,I 0289 08880000 * DO J = 1 TO 10; /* CHECK ALL POSSIBLE VALUES * 08890000 @DO9D4 LA @F,1 0290 08900000 ST @F,J 0290 08910000 * IF COL(I) = TABLE(J) /* IF THIS DIGIT IS OK * 08920000 * THEN GO TO INPUT740; /* CHECK THE NEXT ONE * 08930000 @DO9D0 L @1,J 0291 08940000 LA @E,TABLE-1(@1) 0291 08950000 L @5,I 0291 08960000 LA @A,0(@5,@2) 0291 08970000 BCTR @A,0 0291 08980000 CLC 0(1,@A),0(@E) 0291 08990000 BC 08,INPUT740 0292 09000000 * END; /* * 09010000 * GO TO INPUT750; /* BRANCH OUT IF NOT EQUAL * 09020000 L @F,J 0293 09030000 AH @F,@D2 0293 09040000 @DO9CF ST @F,J 0293 09050000 CH @F,@D15 0293 09060000 BC 12,@DO9D0 0293 09070000 BC 15,INPUT750 0294 09080000 * INPUT740: ; /* * 09090000 * END; /* * 09100000 * INPUT750: CR = CR + I - 1; /* INCREASE POINTER REGISTER * 09110000 INPUT740 L @F,I 0296 09120000 AH @F,@D2 0296 09130000 @DO9D3 ST @F,I 0296 09140000 CH @F,@D4 0296 09150000 BC 12,@DO9D4 0296 09160000 INPUT750 LH @F,@D16 0297 09170000 A @F,I 0297 09180000 AR @2,@F 0297 09190000 * FWORD = '00000000'X; /* INITIALYZE FULLWORD * 09200000 MVC FWORD(4),@X10 0298 09210000 * LENGTH = CR - WR; /* DEFINE LENGTH OF DATA * 09220000 LR @F,@2 0299 09230000 SR @F,@4 0299 09240000 ST @F,LENGTH 0299 09250000 * /* IF THE LENGTH IS ZERO THERE IS NO DECIMAL DATA FIELD AT THIS * 09260000 * /* LOCATION AND THIS SHOULD BE CONSIDERED AN ERROR * 09270000 * IF LENGTH = 0 /* IF NO DECIMAL DATA * 09280000 * THEN RETURN TO INPUT640; /* SET AN ERROR CODE * 09290000 SR @F,@F 0300 09300000 C @F,LENGTH 0300 09310000 BC 07,@9CC 0300 09320000 LA @E,INPUT640 0301 09330000 LM @F,@1,16(@D) 0301 09340000 LM @5,@C,40(@D) 0301 09350000 BCR 15,@E 0301 09360000 * FWORD(5 - LENGTH:4) = DTST; /* MOVE DATA TO FWORD * 09370000 @9CC LR @E,@4 0302 09380000 LA @1,4 0302 09390000 L @5,LENGTH 0302 09400000 LCR @5,@5 0302 09410000 AH @5,@D1 0302 09420000 SR @1,@5 0302 09430000 LA @A,FWORD-1(@5) 0302 09440000 EX @1,@MVC 0302 09450000 * GEN(PACK DBWD(8),FWORD(4)); /* PACK DATA INTO DOUBLEWORD * 09460000 PACK DBWD(8),FWORD(4) 09470000 DS 0H 09480000 * GEN(CVB PR,DBWD); /* CONVERT TO BINARY FORM * 09490000 CVB PR,DBWD 09500000 DS 0H 09510000 * END INTRP; /* * 09520000 @EL04 LM @E,@1,12(@D) 0305 09530000 LM @5,@C,40(@D) 0305 09540000 BCR 15,@E 0305 09550000 * /* * 09560000 * /* THE FOLLOWING ROUTINE RECEIVES AN ADDRESS IN REG 2 AND * 09570000 * /* INCREMENTS IT UNTIL A BLANK IS REACHED * 09580000 * /* * 09590000 * SEARCH: PROCEDURE /* SEARCH FOR BLANK ROUTINE * 09600000 * OPTIONS(NOSAVEAREA, /* SAVEAREA IS NOT REQUIRED * 09610000 * DONTSAVE(2)); /* PARAMETER REGISTER * 09620000 SEARCH STM @E,@1,12(@D) 0306 09630000 STM @3,@C,32(@D) 0306 09640000 * RESTRICT (CR, /* STARTING ADDRESS * 09650000 * 12); /* GPR12 USED AS THE BASE * 09660000 * CNT = 80; /* SET LIMIT OF SEARCH TO 80 * 09670000 LA @F,80 0308 09680000 STH @F,CNT 0308 09690000 * /* IF THE FIRST BLANK HAS BEEN REACHED RETURN TO THE CALLING ROUTINE* 09700000 * INPUT800: IF COL(1) = BLANK /* IF ADDRESS POINTS TO BLANK * 09710000 * THEN RETURN; /* GO BACK TO CALLER * 09720000 INPUT800 CLC 0(1,@2),BLANK 0309 09730000 BC 08,@EL05 0310 09740000 * CR = CR + 1; /* INCREASE POINTER * 09750000 @9CB AH @2,@D2 0311 09760000 * CNT = CNT - 1; /* REDUCE LIMIT BY ONE * 09770000 LH @F,CNT 0312 09780000 BCTR @F,0 0312 09790000 STH @F,CNT 0312 09800000 * /* IF NO BLANK WAS REACHED AFTER 80 COLUMNS SET AN ERROR CODE * 09810000 * IF CNT = 0 /* IF THE LIMIT IS ZERO * 09820000 * THEN GO TO INPUT020; /* SET AN ERROR CODE * 09830000 SR @F,@F 0313 09840000 CH @F,CNT 0313 09850000 BC 08,INPUT020 0314 09860000 * GO TO INPUT800; /* CHECK THE NEXT COLUMN * 09870000 BC 15,INPUT800 0315 09880000 * END SEARCH; /* * 09890000 @EL05 LM @E,@1,12(@D) 0316 09900000 LM @3,@C,32(@D) 0316 09910000 BCR 15,@E 0316 09920000 * /* * 09930000 * /* THE FOLLOWING ROUTINE RECEIVES AN ADDRESS IN REG 2 AND * 09940000 * /* INCREMENTS IT UNTIL A NON-BLANK IS REACHED * 09950000 * /* * 09960000 * SEEK: PROCEDURE /* SEEK NON-BLANK ROUTINE * 09970000 * OPTIONS(NOSAVEAREA, /* SAVEAREA IS NOT REQUIRED * 09980000 * DONTSAVE(2)); /* PARAMETER REGISTER * 09990000 SEEK STM @E,@1,12(@D) 0317 10000000 STM @3,@C,32(@D) 0317 10010000 * RESTRICT (CR, /* STARTENG ADDRESS * 10020000 * 12); /* GPR12 USED AS THE BASE * 10030000 * CNT = 80; /* SET LIMIT OF SEEK TO 80 * 10040000 LA @F,80 0319 10050000 STH @F,CNT 0319 10060000 * /* IF FIRST NON-BLANK HAS BEEN REACHED RETURN TO CALLING ROUTINE * 10070000 * INPUT900: IF COL(1) = BLANK /* IF ADDRESS POINTS TO NON- * 10080000 * THEN RETURN; /* BLANK GO BACK TO CALLER * 10090000 INPUT900 CLC 0(1,@2),BLANK 0320 10100000 BC 07,@EL06 0321 10110000 * CR = CR + 1; /* INCREASE POINTER * 10120000 @9CA AH @2,@D2 0322 10130000 * CNT = CNT - 1; /* REDUCE LIMIT BY ONE * 10140000 LH @F,CNT 0323 10150000 BCTR @F,0 0323 10160000 STH @F,CNT 0323 10170000 * /* IF NO NON-BLANK HAS BEEN REACHED AFTER 80 COLUMNS SET AN ERROR * 10180000 * IF CNT = 0 /* IF THE LIMIT IS ZERO * 10190000 * THEN GO TO INPUT020; /* SET AN ERROR CODE * 10200000 SR @F,@F 0324 10210000 CH @F,CNT 0324 10220000 BC 08,INPUT020 0325 10230000 * GO TO INPUT900; /* CHECK THE NEXT COLUMN * 10240000 BC 15,INPUT900 0326 10250000 * END SEEK; /* * 10260000 @EL06 LM @E,@1,12(@D) 0327 10270000 LM @3,@C,32(@D) 0327 10280000 BCR 15,@E 0327 10290000 * /* * 10300000 * /* THE FOLLOWING ROUTINE IS USED TO READ A DATA CARD * 10310000 * /* * 10320000 * GET: PROCEDURE; /* GET A DATA CARD ROUTINE * 10330000 GET STM @E,@C,12(@D) 0328 10340000 ST @D,@SAV007+4 0328 10350000 LA @F,@SAV007 0328 10360000 ST @F,8(0,@D) 0328 10370000 LR @D,@F 0328 10380000 * DECLARE 10390000 * PARMR REGISTER(1) FIXED(31); /* PARAMETER REGISTER * 10400000 * DECLARE 10410000 * DEVR REGISTER(2); /* ADDRESS OF INPUT DEVICE * 10420000 * RESTRICT (PARMR, /* PARAMETER REGISTER * 10430000 * DEVR, /* ADDRESS OF INPUT DEVICE * 10440000 * 12); /* GPR12 USED AS THE BASE * 10450000 * PARMR = 1; /* SET PARM REG FOR READER * 10460000 LA @1,1 0332 10470000 * GEN(LA DEVR,READCCW); /* INSERT CCW ADDRESS INTO * 10480000 LA DEVR,READCCW 10490000 DS 0H 10500000 * GEN(ST DEVR,CAW); /* CHANNEL ADDRESS WORD * 10510000 ST DEVR,CAW 10520000 DS 0H 10530000 * DEVR = RDRADDR; /* INPUT DEVICE ADDRESS * 10540000 L @2,RDRADDR 0335 10550000 * CALL IO; /* EXECUTE IO OPERATION * 10560000 BAL @E,IO 0336 10570000 * RETURN; /* * 10580000 BC 15,@EL07 0337 10590000 * READCCW: GEN(CCW X'02',INAREA,X'20',80); /* READ CARD TO INAREA * 10600000 READCCW CCW X'02',INAREA,X'20',80 10610000 DS 0H 10620000 * END GET; /* * 10630000 @EL07 L @D,4(0,@D) 0339 10640000 LM @E,@C,12(@D) 0339 10650000 BCR 15,@E 0339 10660000 * END INPUT; /* * 10670000 * CONTROL: /* LOAD BUFFER ROUTINE * 10680000 * PROCEDURE; 10690000 CONTROL STM @E,@C,12(@D) 0341 10700000 ST @D,@SAV008+4 0341 10710000 LA @F,@SAV008 0341 10720000 ST @F,8(0,@D) 0341 10730000 LR @D,@F 0341 10740000 * /******************************************************************** 10750000 * /* * 10760000 * /* * 10770000 * /* NAME * 10780000 * /* CONTROL * 10790000 * /* * 10800000 * /* FUNCTION * 10810000 * /* THIS ROUTINE PERFORMS THE OPERATIONS REQUESTED IN THE JOB * 10820000 * /* CONTROL CARDS BY LOADING THE UCS AND FCB BUFFERS * 10830000 * /* * 10840000 * /* ENTRY POINTS * 10850000 * /* CONTROL- THIS POINT IS CALLED BY THE INPUT ROUTINE * 10860000 * /* * 10870000 * /* INPUT * 10880000 * /* INPUT TO THIS ROUTINE IS THE DATA AREAS DEFINED IN THE INIT * 10890000 * /* AND INPUT ROUTINES. NO DATA SETS ARE READ-FROM BY THIS * 10900000 * /* ROUTINE. * 10910000 * /* * 10920000 * /* OUTPUT * 10930000 * /* OUTPUT FROM THE CONTROL ROUTINE IS THE UCS AREA AFTER THIS * 10940000 * /* IMAGE WAS REREAD FROM THE BUFFER * 10950000 * /* * 10960000 * /* EXTERNAL ROUTINES * 10970000 * /* IO * 10980000 * /* * 10990000 * /* EXITS, NORMAL * 11000000 * /* IF ALL CCWS SET UP BY THIS ROUTINE ARE COMPLETED WITHOUT AN * 11010000 * /* ERROR, THE OUTPUT ROUTINE IS CALLED. * 11020000 * /* * 11030000 * /* EXITS, ERROR * 11040000 * /* NONE * 11050000 * /* * 11060000 * /* TABLE/WORK AREAS * 11070000 * /* FOLDBIT * 11080000 * /* UCSLOAD * 11090000 * /* FCBING * 11100000 * /* * 11110000 * /******************************************************************** 11120000 * RESTRICT (12); /* GPR12 USED AS THE BASE * 11130000 * GENERATE; 11140000 * 11150000 * REGISTER USAGE 11160000 * 11170000 CCWR EQU 4 ADDRESS OF CCW TO BE EXECUTED 11180000 COUNTR EQU 5 COUNT USED TO LIMIT THE LOOP 11190000 QUADR EQU 6 QUADRANT VALUE OF UCS BYTE 11200000 LOOPR EQU 6 LOOP CONTROL Y00391 11210000 INDXR EQU 7 INDEX VALUE OF UCS BYTE 11220000 WRKR EQU 8 WORK REGISTER 11230000 UCSR EQU 9 ADDRESS OF UCS IMAGE 11240000 RTNR EQU 14 ADDRESS TO BE RETURNED TO 11250000 * 11260000 * DISPLACEMENT AND CONSTANT VALUES 11270000 * 11280000 EUCS EQU 0 EXTENDED UCS BUFFER 11290000 INC EQU 1 UCS IMAGE ADDRESS INCREMENT 11300000 ORL EQU 1 LENGTH OF DATA CHECK 11310000 ADDRLNTH EQU 3 LENGTH OF PRINTER ADDRESS 11320000 PKLNTH EQU 4 LENGTH OF PACK 11330000 SGNBTS EQU 4 SIGN BITS TO BE SHIFTED OUT 11340000 CCWFLAGS EQU 12 DISPLACEMENT OF CHAINING FLAG 11350000 BLKLNTH EQU 15 BLANK EXTENDED UCS BUFFER 11360000 SHFTLNTH EQU 26 SHIFT LENGTH TO DEFINE QUADRANT 11370000 CLRLNTH EQU 80 EXTENDED UCS BUFFER LENGTH 11380000 IMGLNTH EQU 432 UCS IMAGE LENGTH 11390000 FOLDMASK EQU X'01' FOLDBIT CHECK 11400000 CHAINBIT EQU X'40' CHAIN BIT TO LINK CCWS 11410000 NLBLK EQU X'C0' NULL - BLANK CODE 11420000 LOUNITS EQU X'F0' TEST FOR 0 THRU 9 A50331 11430000 * 11440000 * 11450000 * 11460000 SR PARMR,PARMR SET PARAMETER REG FOR PRINTER 11470000 LA DEVR,PTRADDR GET PTR TO ADDRESS Y00391 11480000 LA LOOPR,ADDRLNTH INITIALIZE LOOP CONTROL Y00391 11490000 * A50331 11500000 NXTCHR TM EUCS(DEVR),LOUNITS IS IT 0 THRU 9 Y00391 11510000 BO INCR YES-GO CHECK NEXT CHAR Y00391 11520000 TR EUCS(INC,DEVR),TBL TRANSLATE A THRU F Y00391 11530000 INCR LA DEVR,INC(DEVR) INCREMENT TO NXT CHAR Y00391 11540000 BCT LOOPR,NXTCHR GO CHECK NEXT CHAR Y00391 11550000 PACK FLWD(PKLNTH),PTRADDR(ADDRLNTH) CHANGE PRINTER @ FORMAT 11560000 L DEVR,FLWD INITIALIZE PRINTER ADDRESS REG 11570000 SRL DEVR,SGNBTS SHIFT OUT SIGN BITS 11580000 LA UCSR,UCSLOAD LOAD ADDRESS OF USER-DEFINED IMG 11590000 LA WRKR,IMGLNTH(UCSR) LOAD ADDRESS OF EXTENDED UCSB 11600000 XC EUCS(CLRLNTH,WRKR),EUCS(WRKR) CLEAR EXTENDED UCSB 11610000 LA WRKR,BLKLNTH(WRKR) LOAD ADDRESS OF DATA CHECK FIELD 11620000 OI EUCS(WRKR),NLBLK ALLOW NULL OR BLANK PRINTING 11630000 LA COUNTR,IMGLNTH SET COUNTER TO IMAGE LENGTH 11640000 CNTRL050 SR QUADR,QUADR CLEAR QUADRANT REGISTER 11650000 SR INDXR,INDXR CLEAR INDEX REGISTER 11660000 IC INDXR,EUCS(UCSR) INSERT ONE UCS BYTE 11670000 SLDL QUADR,SHFTLNTH SEPERATE QUADRANT AND INDEX 11680000 SRL INDXR,SHFTLNTH (QUADR=QUADRANT INDXR=INDEX) 11690000 LA QUADR,QUADIND(QUADR) LOAD QUADRANT INDICATOR ADDRESS 11700000 LA INDXR,EUCS(WRKR,INDXR) LOAD DATA CHECK BYTE ADDRESS 11710000 OC EUCS(ORL,INDXR),EUCS(QUADR) OR DATA CHECK BYTE WITH QUAD 11720000 LA UCSR,INC(UCSR) INCREMENT UCS IMAGE ADDRESS 11730000 BCT CNTR,CNTRL050 LOOP TILL ALL BYTES CHECKED 11740000 TM FOLDBIT,FOLDMASK IF FOLD IS NOT REQUESTED 11750000 BZ CNTRL100 GO TO CNTRL100 11760000 OI LDUCS+CCWFLAGS,CHAINBIT CHAIN FOLD CCW TO LOAD UCS CCW 11770000 CNTRL100 LA CCWR,LDUCS PLACE ADDRESS OF LOAD UCS CCW 11780000 ST CCWR,CAW INTO CHANNEL ADDRESS WORD 11790000 BAL RTNR,IO EXECUTE LOAD UCS CCW CHAIN 11800000 LA CCWR,LDFCB PLACE ADDRESS OF LOAD FCB CCW 11810000 ST CCWR,CAW INTO CHANNEL ADDRESS WORD 11820000 BAL RTNR,IO EXECUTE LOAD FCB CCW CHAIN 11830000 LA CCWR,RDUCS PLACE ADDRESS OF READ UCS CCW 11840000 ST CCWR,CAW INTO CHANNEL ADDRESS WORD 11850000 BAL RTNR,IO EXECUTE READ UCS CCW CHAIN 11860000 B OUTPUT PRINT VERIFICATION OF IMAGE 11870000 FLWD DS F FULLWORD USED FOR PACK 11880000 TBL EQU *-193 Y00391 11890000 DC X'FAFBFCFDFEFF' TRANSLATE TABLE Y00391 11900000 QUADIND DC X'80402010' QUADRANT INDICATOR 11910000 LDUCS CCW X'73',0,X'40',1 BLOCK DATA CHECK 11920000 CCW X'FB',UCSLOAD,X'00',512 LOAD UCS BUFFER 11930000 CCW X'43',0,X'00',1 FOLD 11940000 LDFCB CCW X'63',FCBIMG,X'00',180 LOAD FORMS CONTROL BUFFER 11950000 RDUCS CCW X'0A',UCSLOAD,X'00',512 READ UCS BUFFER 11960000 DS 0H 11970000 * END CONTROL; /* * 11980000 @EL08 L @D,4(0,@D) 0344 11990000 LM @E,@C,12(@D) 0344 12000000 BCR 15,@E 0344 12010000 * OUTPUT: /* PRINT VERIFICATION ROUTINE * 12020000 * PROCEDURE; 12030000 OUTPUT STM @E,@C,12(@D) 0345 12040000 ST @D,@SAV009+4 0345 12050000 LA @F,@SAV009 0345 12060000 ST @F,8(0,@D) 0345 12070000 LR @D,@F 0345 12080000 * /******************************************************************** 12090000 * /* * 12100000 * /* * 12110000 * /* NAME * 12120000 * /* OUTPUT * 12130000 * /* * 12140000 * /* FUNCTION * 12150000 * /* THIS ROUTINE IS USED TO PRINT THE UCS AND FCB NAMES AND THE * 12160000 * /* UCS IMAGE ON THE 3211 FOR VERIFICATION. * 12170000 * /* * 12180000 * /* ENTRY POINTS * 12190000 * /* OUTPUT- THIS POINT IS CALLED BY THE CONTROL ROUTINE * 12200000 * /* * 12210000 * /* INPUT * 12220000 * /* INPUT TO THIS ROUTINE IS THE DATA AREAS DEFINED IN THE INPUT * 12230000 * /* ROUTINE. NO DATA SETS ARE READ BY THIS ROUTINE. * 12240000 * /* * 12250000 * /* OUTPUT * 12260000 * /* OUTPUT FROM THIS ROUTINE IS A DATA SET TO THE PRINTER. THIS * 12270000 * /* WILL CONTAIN A MESSAGE OF THE UCSNAME AND FCBNAME AND AN * 12280000 * /* EIGHT LINE PRINTOUT OF THE UCS IMAGE AS IT APPEARS ON THE UCS * 12290000 * /* STATEMENT OF THE JOB CONTROL CARDS. * 12300000 * /* * 12310000 * /* EXTERNAL ROUTINES * 12320000 * /* IO * 12330000 * /* * 12340000 * /* EXITS, NORMAL * 12350000 * /* IF ALL CCWS SET UP BY THIS ROUTINE ARE COMPLETED WITHOUT AN * 12360000 * /* ERROR, THE WAIT ROUTINE IS CALLED TO END THE UTILITY. * 12370000 * /* * 12380000 * /* EXITS, ERROR * 12390000 * /* NONE * 12400000 * /* * 12410000 * /* TABLES/WORK AREAS * 12420000 * /* UCSNMST * 12430000 * /* FCBNMST * 12440000 * /* UCSLOAD * 12450000 * /* * 12460000 * /******************************************************************** 12470000 * RESTRICT (12); /* GPR12 USED AS THE BASE * 12480000 * GENERATE; 12490000 * 12500000 * REGISTER USAGE 12510000 * 12520000 PARAMR EQU 1 PARAMETER REGISTER 12530000 POINTR EQU 3 POINTER REGISTER TO UCS LOAD 12540000 CPAR EQU 4 CHANNEL PROGRAM ADDRESS 12550000 CNTR EQU 5 COUNT USED TO LIMIT THE LOOP 12560000 RETURNR EQU 14 ADDRESS TO BE RETURNED TO 12570000 * 12580000 * DISPLACEMENT AND CONSTANT VALUES 12590000 * 12600000 DISZ EQU 0 DISPLACEMENT OF ZERO 12610000 PTLN2 EQU 2 COLUMN 2 OF PRINT LINE 12620000 CDLNTH EQU 3 ERROR CODE LENGTH 12630000 LPLNTH EQU 7 LENGTH OF LOOP TO PRINT UCS 12640000 PTLN7 EQU 7 COLUMN 7 OF PRINT LINE 12650000 MOVELNTH EQU 8 LENGTH OF UCS AND FCB NAMES 12660000 UCSNM EQU 24 DISPLACEMENT OF UCSNAME 12670000 MVLN2 EQU 40 LENGTH OF LAST UCS IMAGE LINE 12680000 FCBNM EQU 56 DISPLACEMENT OF FCBNAME 12690000 MVLN EQU 56 LENGTH OF UCS IMAGE LINE 12700000 CLRL EQU 131 LENGTH OF CLEAR PRINT LINE 12710000 BLK EQU X'40' BLANK VALUE FOR CLEARING 12720000 SR PARAMR,PARAMR SET PARAMETER REG FOR PRINTER 12730000 MVC PTLN+UCSNM(MOVELNTH),UCSNMST INSERT UCSNAME INTO PTLN 12740000 MVC PTLN+FCBNM(MOVELNTH),FCBNMST INSERT FCBNAME INTO PTLN 12750000 LA CPAR,NMCCW LOAD ADDRESS OF CCW TO PUT NAMES 12760000 ST CPAR,CAW STORE CCW ADDRESS IN CAW 12770000 BAL RETURNR,IO EXECUTE PRINT NAMES CCW CHAIN 12780000 LA CNTR,LPLNTH LOAD LENGTH OF LOOP IN COUNTER 12790000 LA POINTR,UCSLOAD LOAD ADDRESS OF UCS IMAGE 12800000 OUT100 MVI PTLN,BLK CLEAR FIRST COLUMN OF PRINT LINE 12810000 MVC PTLN+PTLN2(CLRL),PTLN CLEAR THE REST OF PRINT LINE 12820000 MVC PTLN+PTLN7(MVLN),DISZ(POINTR) MOVE 56 CHARACTERS OF UCS 12830000 LA CPAR,CCWUCS PLACE ADDRESS OF PRINT UCS CCW 12840000 ST CPAR,CAW INTO CHANNEL ADDRESS WORD 12850000 BAL RETURNR,IO EXECUTE PRINT UCS CCW 12860000 LA POINTR,MVLN(POINTR) INCREASE POINTER BY MOVE LENGTH 12870000 BCT CNTR,OUT100 IF MORE RETURN TO PRINT NEXT ONE 12880000 MVI PTLN,BLK CLEAR FIRST COLUMN OF PRINT LINE 12890000 MVC PTLN+PTLN2(CLRL),PTLN CLEAR THE REST OF PRINT LINE 12900000 MVC PTLN+PTLN7(MVLN2),DISZ(POINTR) MOVE 40 CHARACTERS OF UCS 12910000 LA CPAR,CCWUCS PLACE ADDRESS OF PRINT UCS CCW 12920000 ST CPAR,CAW INTO CHANNEL ADDRESS WORD 12930000 BAL RETURNR,IO EXECUTE PRINT UCS CCW 12940000 LA CPAR,CCWEND PLACE ADDRESS OF END CCW 12950000 ST CPAR,CAW INTO CHANNEL ADDRESS WORD 12960000 BAL RETURNR,IO EXECUTE END CCW CHAIN 12970000 MVC ERRCODE(CDLNTH),CB01 MOVE CODE FOR END OF JOB 12980000 B WAIT END THE UTILITY 12990000 NMCCW CCW X'11',PTLN,X'00',132 PRINT NAMES AND SPACE TWO LINES 13000000 CCWUCS CCW X'09',PTLN,X'00',132 PRINT UCS LINE AND SPACE A LINE 13010000 CCWEND CCW X'13',0,X'40',1 SPACE ONE LINE 13020000 CCW X'89',ENDMESS,X'00',132 PRINT END OF JOB MESSAGE 13030000 PTLN DC CL132' UCSNAME= FCX13040000 BNAME= ' 13050000 ENDMESS DC CL132' NORMAL END OF JOB ' 13060000 DS 0H 13070000 * END OUTPUT; /* * 13080000 @EL09 L @D,4(0,@D) 0348 13090000 LM @E,@C,12(@D) 0348 13100000 BCR 15,@E 0348 13110000 * WAIT: /* END THE UTILITY ROUTINE * 13120000 * PROCEDURE OPTIONS(NOSAVEAREA, /* DONT ESTABLISH REG 13 * 13130000 * DONTSAVE); /* DONT SAVE ANY REGISTERS * 13140000 WAIT EQU * 0349 13150000 * /******************************************************************** 13160000 * /* * 13170000 * /* * 13180000 * /* NAME * 13190000 * /* WAIT * 13200000 * /* * 13210000 * /* FUNCTION * 13220000 * /* THIS ROUTINE TERMINATES THE UTILITY BY LOADING A WAIT PSW WITH* 13230000 * /* THE ERROR CODE IN THE ADDRESS PORTION. * 13240000 * /* * 13250000 * /* ENTRY POINTS * 13260000 * /* WAIT IS THE ONLY ENTRY POINT TO THIS ROUTINE. * 13270000 * /* * 13280000 * /* INPUT * 13290000 * /* NONE * 13300000 * /* * 13310000 * /* OUTPUT * 13320000 * /* NONE * 13330000 * /* * 13340000 * /* EXTERNAL ROUTINES * 13350000 * /* NONE * 13360000 * /* * 13370000 * /* EXITS, NORMAL * 13380000 * /* NORMAL EXIT FROM THE WAIT ROUTINE IS BY LOADING A NEW PSW. * 13390000 * /* * 13400000 * /* EXITS, ERROR * 13410000 * /* NONE * 13420000 * /* * 13430000 * /* TABLES/WORK AREAS * 13440000 * /* ERRCODE * 13450000 * /* WAITPSW * 13460000 * /* * 13470000 * /******************************************************************** 13480000 * RESTRICT (12); /* GPR12 USED AS THE BASE * 13490000 * GENERATE; 13500000 * 13510000 * DISPLACEMENT AND CONSTANT VALUES 13520000 * 13530000 ERCDLNTH EQU 3 ERROR CODE LENGTH 13540000 INSTA EQU 5 INSTRUCTION ADDRESS 13550000 MVC WAITPSW+INSTA(ERCDLNTH),ERRCODE PUT ERROR CODE IN PSW 13560000 LPSW WAITPSW TERMINATE THE PROGRAM 13570000 DS 0H 13580000 * END WAIT; /* * 13590000 @EL10 BCR 15,@E 0352 13600000 * IO: /* PREFORM I/O OPERATIONS * 13610000 * PROCEDURE; 13620000 IO STM @E,@C,12(@D) 0353 13630000 ST @D,@SAV011+4 0353 13640000 LA @F,@SAV011 0353 13650000 ST @F,8(0,@D) 0353 13660000 LR @D,@F 0353 13670000 * /******************************************************************** 13680000 * /* * 13690000 * /* * 13700000 * /* NAME * 13710000 * /* IO * 13720000 * /* * 13730000 * /* FUNCTION * 13740000 * /* THIS ROUTINE WILL HANDLE ALL INPUT AND OUTPUT FOR THE UTILITY * 13750000 * /* BY STARTING THE CCW CHAIN AND CHECKING FOR NORMAL COMPLETION. * 13760000 * /* * 13770000 * /* ENTRY POINTS * 13780000 * /* IO- THIS POINT MAY BE CALLED FROM THE INPUT, CONTROL, OR * 13790000 * /* OUTPUT ROUTINE. * 13800000 * /* * 13810000 * /* INPUT * 13820000 * /* INPUT TO THE IO ROUTINE IS THE CONTENTS OF GPR2 WHICH * 13830000 * /* CONTAINS THE ADDRESS OF THE DEVICE TO BE STARTED. * 13840000 * /* * 13850000 * /* OUTPUT * 13860000 * /* NONE * 13870000 * /* * 13880000 * /* EXTERNAL ROUTINES * 13890000 * /* NONE * 13900000 * /* * 13910000 * /* EXITS, NORMAL * 13920000 * /* UPON NORMAL COMPLETION CONTROL IS RETURNED TO THE CALLING * 13930000 * /* PROGRAM(INPUT,CONTROL,OUTPUT) VIA REGISTER 14. * 13940000 * /* * 13950000 * /* EXITS, ERROR * 13960000 * /* IF AN ERROR OCCURS DURING THE IO OPERATION THE WAIT ROUTINE * 13970000 * /* IS CALLED TO TERMINATE THE UTILITY. * 13980000 * /* * 13990000 * /* TABLES/WORK AREAS * 14000000 * /* ERROR CODE * 14010000 * /* CORE LOCATION 2 TO 7 * 14020000 * /* * 14030000 * /******************************************************************** 14040000 * RESTRICT (12); /* GPR12 USED AS THE BASE * 14050000 * GENERATE; 14060000 * 14070000 * REGISTER USAGE 14080000 * 14090000 CPR EQU 4 ADDRESS OF CHANNEL PROGRAM 14100000 * 14110000 * DISPLACEMENT AND CONSTANT VALUES 14120000 * 14130000 DEVDIS EQU 0 DISPLACEMENT OF DEVICE ADDRESS 14140000 NOTOP EQU 1 NOT OPERATIONAL 14150000 BUSY EQU 2 CHANNEL - DEVICE BUSY 14160000 LC2 EQU 2 LOW CORE LOCATION - 2 14170000 CODE EQU 3 PSW INTERRUPTION CODE 14180000 ERLNTH EQU 3 ERROR CODE LENGTH 14190000 LC3 EQU 3 LOW CORE LOCATION - 3 14200000 CSWST EQU 4 CHANNEL STATUS WORD STORED 14210000 STAT1 EQU 4 STATUS BYTE 1 14220000 DIS5 EQU 5 DISPLACEMENT OF PSW ADDRESS 14230000 STAT2 EQU 5 STATUS BYTE 2 14240000 SNSLNTH EQU 6 LENGTH OF DEVICE SENSE 14250000 UE EQU X'01' UNIT EXCEPTION 14260000 UC EQU X'02' UNIT CHECK 14270000 DE EQU X'04' DEVICE END 14280000 CE EQU X'0F' CHANNEL ERROR 14290000 CHANER EQU X'0F' CHANNEL ERROR CODE FOR SEREP 14300000 NODEVEND EQU X'1F' NO-DEVICE-END CODE FOR SEREP 14310000 CUE EQU X'20' CONTROL UNIT END 14320000 DNR EQU X'40' DEVICE NOT READY SENSE BIT 14330000 LTR PARMR,PARMR IF THIS OPERATION IS FOR THE 14340000 BZ IO100 PRINTER GO TO IO100 14350000 MVC ERRCODE(ERLNTH),RDRCD SET UP ERROR CODE FOR READER 14360000 B IO200 GO TO IO200 14370000 IO100 MVC ERRCODE(ERLNTH),PTRCD SET UP ERROR CODE FOR PRINTER 14380000 SSM DISABLE DISABLE INTERRUPTS A51547 14390000 IO200 SIO DEVDIS(DEVR) INITIATE I/O OPERATION 14400000 BC BUSY,IO200 BUSY - REISSUE COMMAND 14410000 BC NOTOP,IO400 NOT OPERATIONAL - SET ERROR 14420000 BC CSWST,IO320 CSW STORED - CHECK THE CSW 14430000 IO300 TIO DEVDIS(DEVR) TEST I/O OPERATION 14440000 BC BUSY,IO300 BUSY - RETRY TEST 14450000 BC NOTOP,IO400 NOT OPERATIONAL - SET ERROR 14460000 BC CSWST,IO350 CSW STORED - CHECK THE CSW 14470000 TM CSW+STAT1,DE IF NO DEVICE END 14480000 BZ IO800 SET AN ERROR CODE 14490000 SSM ENABLE ALLOW INTERRUPTS A51547 14500000 B IO990 RETURN TO CALLING ROUTINE 14510000 IO320 TM CSW+STAT1,UC IF A UNIT CHECK 14520000 BNZ IO600 OBTAIN THE SENSE 14530000 TM CSW+STAT2,CE IF A CHANNEL ERROR 14540000 BNZ IO700 SET CHANNEL ERROR MESSAGE 14550000 TM CSW+STAT1,CUE IF CONTROL UNIT END 14560000 BNZ IO200 REISSUE COMMAND 14570000 TM CSW+STAT1,UE IF UNIT EXCEPTION 14580000 BNZ IO390 CONTROL STATEMENT ERROR 14590000 B IO300 OTHER CONDITIONS - CONTINUE 14600000 IO350 TM CSW+STAT1,UC IF A UNIT CHECK 14610000 BNZ IO600 OBTAIN THE SENSE 14620000 TM CSW+STAT2,CE IF A CHANNEL ERROR 14630000 BNZ IO700 SET CHANNEL ERROR MESSAGE 14640000 TM CSW+STAT1,UE IF UNIT EXCEPTION 14650000 BNZ IO390 CONTROL STATEMENT ERROR 14660000 B IO300 OTHER CONDITIONS - RETEST 14670000 IO390 MVC ERRCODE(ERLNTH),CB02 SET CONTROL STATEMENT ERROR 14680000 B WAIT TERMINATE THE PROGRAM 14690000 IO400 OC ERRCODE(ERLNTH),CB11 SET DEVICE NOT ON LINE MESSAGE 14700000 B WAIT TERMINATE THE PROGRAM 14710000 IO500 OC ERRCODE(ERLNTH),CB12 SET DEVICE NOT READY MESSAGE 14720000 B WAIT TERMINATE THE PROGRAM 14730000 IO600 LTR PARMR,PARMR IF THIS OPERATION IS FOR THE 14740000 BZ IO610 PRINTER GO TO IO610 14750000 LA CPR,RDRSNS LOAD READER SENSE CCW 14760000 B IO620 GO TO IO620 14770000 IO610 LA CPR,PTRSNS LOAD PRINTER SENSE CCW 14780000 IO620 ST CPR,CAW STORE SENSE CCW IN CAW 14790000 IO630 SIO DEVDIS(DEVR) START SENSE CCW 14800000 BC BUSY,IO630 BUSY - RESTART 14810000 IO640 TIO DEVDIS(DEVR) TEST SENSE CCW 14820000 BC BUSY,IO640 BUSY RETEST 14830000 LTR PARMR,PARMR IF THIS OPERATION IS FOR THE 14840000 BZ IO650 PRINTER GO TO IO650 14850000 TM LC3,DNR IF THE READER IS NOT READY 14860000 BNZ IO500 GO TO IO500 14870000 B IO660 GO TO IO660 14880000 IO650 TM LC2,DNR IF THE PRINTER IS NOT READY 14890000 BNZ IO500 GO TO IO500 14900000 IO660 OC ERRCODE(ERLNTH),CB13 SET DEVICE UNIT CHECK MESSAGE 14910000 B WAIT TERMINATE THE PROGRAM 14920000 IO700 OC ERRCODE(ERLNTH),CB14 SET CHANNEL ERROR MESSAGE 14930000 MVI MCNPSW+CODE,CHANER INDICATE CHANNEL ERROR TO SEREP 14940000 B IO900 GO TO IO900 14950000 IO800 OC ERRCODE(ERLNTH),CB15 SET NO DEVICE END MESSAGE 14960000 MVI MCNPSW+CODE,NODEVEND INDICATE NO-DEVICE-END TO SEREP 14970000 OC EXTOPSW(SNSLNTH),EXTOPSW CLEAR SENSE AREA 14980000 LTR PARMR,PARMR IF THIS OPERATION IS FOR THE 14990000 BZ IO810 PRINTER GO TO IO810 15000000 LA CPR,RDRSNS2 LOAD READER SENSE CCW 15010000 B IO820 GET SENSE 15020000 IO810 LA CPR,PTRSNS2 LOAD PRINTER SENSE CCW 15030000 IO820 ST CPR,CAW STORE SENSE CCW IN CAW 15040000 IO830 SIO DEVDIS(DEVR) START SENSE CCW 15050000 BC BUSY,IO830 BUSY - RESTART 15060000 IO840 TIO DEVDIS(DEVR) TEST SENSE CCW 15070000 BC BUSY,IO840 BUSY - RETEST 15080000 IO900 MVC WAITPSW+DIS5(ERLNTH),ERRCODE PUT ERROR CODE IN PSW 15090000 LPSW WAITPSW TERMINATE THE PROGRAM 15100000 RDRCD DC X'000000' READER ERROR CODE FORMAT 15110000 PTRCD DC X'000008' PRINTER ERROR CODE FORMAT 15120000 RDRSNS CCW X'04',LC3,X'00',1 CARD READER SENSE CCW 15130000 PTRSNS CCW X'04',LC2,X'00',6 PRINTER SENSE CCW 15140000 RDRSNS2 CCW X'04',EXTOPSW,X'00',1 CARD READER SENSE CCW FOR SEREP 15150000 PTRSNS2 CCW X'04',EXTOPSW,X'00',6 PRINTER SENSE CCW FOR SEREP 15160000 DISABLE DC X'00' PREVENT INTERRUPTS MASK A51547 15170000 ENABLE DC X'FE' ALLOW INTERRUPTS MASK A51547 15180000 DS 0H 15190000 * IO990: RETURN; /* RETURN TO CALLING PROGRAM * 15200000 * END IO; /* * 15210000 @EL11 L @D,4(0,@D) 0357 15220000 LM @E,@C,12(@D) 0357 15230000 BCR 15,@E 0357 15240000 * END ICAPRTBL; /* * 15250000 @DATA1 EQU * 15260000 @0 EQU 00 EQUATES FOR REGISTERS 0-15 15270000 @1 EQU 01 15280000 @2 EQU 02 15290000 @3 EQU 03 15300000 @4 EQU 04 15310000 @5 EQU 05 15320000 @6 EQU 06 15330000 @7 EQU 07 15340000 @8 EQU 08 15350000 @9 EQU 09 15360000 @A EQU 10 15370000 @B EQU 11 15380000 @C EQU 12 15390000 @D EQU 13 15400000 @E EQU 14 15410000 @F EQU 15 15420000 @D1 DC H'5' 15430000 @D2 DC H'1' 15440000 @D3 DC H'16' 15450000 @D4 DC H'3' 15460000 @D5 DC H'8' 15470000 @D6 DC H'40' 15480000 @D7 DC H'56' 15490000 @D8 DC H'15' 15500000 @D9 DC H'71' 15510000 @D10 DC H'4' 15520000 @D11 DC H'2' 15530000 @D12 DC H'180' 15540000 @D13 DC H'6' 15550000 @D14 DC H'12' 15560000 @D15 DC H'10' 15570000 @D16 DC H'-1' 15580000 @MVC MVC 0(1,@A),0(@E) 15590000 DS 0F 15600000 @X10 DC X'00000000' 15610000 DS 0D 15620000 @DATA EQU * 15630000 CB01 EQU * 3 BYTE(S) 15640000 DC X'000B01' 15650000 CB02 EQU * 3 BYTE(S) 15660000 DC X'000B02' 15670000 CB03 EQU * 3 BYTE(S) 15680000 DC X'000B03' 15690000 CB04 EQU * 3 BYTE(S) 15700000 DC X'000B04' 15710000 CB05 EQU * 3 BYTE(S) 15720000 DC X'000B05' 15730000 CB06 EQU * 3 BYTE(S) 15740000 DC X'000B06' 15750000 CB07 EQU * 3 BYTE(S) 15760000 DC X'000B07' 15770000 CB0A EQU * 3 BYTE(S) 15780000 DC X'000B0A' 15790000 CB0B EQU * 3 BYTE(S) 15800000 DC X'000B0B' 15810000 CB0C EQU * 3 BYTE(S) 15820000 DC X'000B0C' 15830000 CB11 EQU * 3 BYTE(S) 15840000 DC X'000B11' 15850000 CB12 EQU * 3 BYTE(S) 15860000 DC X'000B12' 15870000 CB13 EQU * 3 BYTE(S) 15880000 DC X'000B13' 15890000 CB14 EQU * 3 BYTE(S) 15900000 DC X'000B14' 15910000 CB15 EQU * 3 BYTE(S) 15920000 DC X'000B15' 15930000 RDRADDR EQU @DATA+00000048 4 BYTE(S) ON WORD 15940000 ORG @DATA+00000056 15950000 WAITPSW EQU * 8 BYTE(S) ON DWORD 15960000 DC X'0006000000000000' 15970000 UCSLOAD EQU @DATA+00000064 512 BYTE(S) 15980000 FCBIMG EQU @DATA+00000576 180 BYTE(S) 15990000 ORG FCBIMG+00000000 16000000 A00000 EQU * 180*1 BYTE(S) 16010000 DC 00180X'00' 16020000 FOLDBIT EQU * 8 BIT(S) ON BYTE 16030000 DC X'00' 16040000 PTRADDR EQU @DATA+00000757 3 BYTE(S) 16050000 ORG @DATA+00000760 16060000 UCSNMST EQU * 9 BYTE(S) 16070000 DC C' ' 16080000 DC 00008C' ' 16090000 FCBNMST EQU * 9 BYTE(S) 16100000 DC C' ' 16110000 DC 00008C' ' 16120000 ERRCODE EQU @DATA+00000778 3 BYTE(S) 16130000 UTPSW EQU @DATA+00000784 8 BYTE(S) ON DWORD 16140000 ORG UTPSW+00000000 16150000 SYSMASK EQU * 8 BIT(S) ON BYTE 16160000 DC X'FE' 16170000 KEYAMWP EQU * 8 BIT(S) ON BYTE 16180000 DC B'00000100' 16190000 INTCODE EQU * 16 BIT(S) ON BYTE 16200000 DC X'0000' 16210000 PGMMASK EQU * 8 BIT(S) ON BYTE 16220000 DC X'00' 16230000 INSTADDR EQU * 3 BYTE POINTER ON WORD+1 16240000 DC AL3(INIT200) 16250000 INITSAVE EQU @DATA+00000792 72 BYTE(S) ON WORD 16260000 RDRR EQU 00000011 FULLWORD INTEGER REGISTER 16270000 BASER EQU 00000012 FULLWORD INTEGER REGISTER 16280000 SAVER EQU 00000013 FULLWORD INTEGER REGISTER 16290000 @SAV003 EQU @DATA+00000864 72 BYTE(S) ON WORD 16300000 FLAG EQU @DATA+00000936 8 BIT(S) ON BYTE 16310000 JOBFLAG EQU FLAG+00000000 1 BIT(S) 16320000 UCSFLAG EQU FLAG+00000000 1 BIT(S) 16330000 FCBFLAG EQU FLAG+00000000 1 BIT(S) 16340000 DFNFLAG EQU FLAG+00000000 1 BIT(S) 16350000 ENDFLAG EQU FLAG+00000000 1 BIT(S) 16360000 FLAGDFN EQU @DATA+00000937 8 BIT(S) ON BYTE 16370000 ADDRFLAG EQU FLAGDFN+00000000 1 BIT(S) 16380000 FOLDFLAG EQU FLAGDFN+00000000 1 BIT(S) 16390000 FLAGFCB EQU @DATA+00000938 8 BIT(S) ON BYTE 16400000 LPIFLAG EQU FLAGFCB+00000000 1 BIT(S) 16410000 FEFLAG EQU FLAGFCB+00000000 1 BIT(S) 16420000 LNCHFLAG EQU FLAGFCB+00000000 1 BIT(S) 16430000 ORG @DATA+00000939 16440000 CJOB EQU * 3 BYTE(S) 16450000 DC C'JOB' 16460000 CDFN EQU * 3 BYTE(S) 16470000 DC C'DFN' 16480000 CUCS EQU * 3 BYTE(S) 16490000 DC C'UCS' 16500000 CFCB EQU * 3 BYTE(S) 16510000 DC C'FCB' 16520000 CEND EQU * 3 BYTE(S) 16530000 DC C'END' 16540000 CADDR EQU * 4 BYTE(S) 16550000 DC C'ADDR' 16560000 CFOLD EQU * 4 BYTE(S) 16570000 DC C'FOLD' 16580000 CY EQU * 1 BYTE(S) 16590000 DC C'Y' 16600000 CN EQU * 1 BYTE(S) 16610000 DC C'N' 16620000 CFORMEND EQU * 7 BYTE(S) 16630000 DC C'FORMEND' 16640000 CLNCH EQU * 4 BYTE(S) 16650000 DC C'LNCH' 16660000 CLPI EQU * 3 BYTE(S) 16670000 DC C'LPI' 16680000 C6 EQU * 1 BYTE(S) 16690000 DC C'6' 16700000 C8 EQU * 1 BYTE(S) 16710000 DC C'8' 16720000 BLANK EQU * 1 BYTE(S) 16730000 DC X'40' 16740000 COMMA EQU * 1 BYTE(S) 16750000 DC C',' 16760000 RPAREN EQU * 1 BYTE(S) 16770000 DC C')' 16780000 LPAREN EQU * 1 BYTE(S) 16790000 DC C'(' 16800000 UCSSEQ EQU @DATA+00000984 8 BIT(S) ON BYTE 16810000 MVLNTH EQU @DATA+00000985 8 BIT(S) ON BYTE 16820000 FCBSAVE EQU @DATA+00000988 FULLWORD POINTER 16830000 JCLSTRT EQU 00000000 FULLWORD INTEGER 16840000 FCBJCL EQU @DATA+00000992 300 BYTE(S) 16850000 ORG @DATA+00001292 16860000 LPI8 EQU * 8 BIT(S) ON BYTE 16870000 DC X'10' 16880000 CNT EQU @DATA+00001294 HALFWORD INTEGER 16890000 INAREA EQU @DATA+00001296 80 BYTE(S) 16900000 ORG @DATA+00001376 16910000 CLRBYTE EQU * 8 BIT(S) ON BYTE 16920000 DC X'00' 16930000 NUM EQU * 16 BYTE(S) 16940000 DC C'0123456789ABCDEF' 16950000 ENDBIT EQU * 8 BIT(S) ON BYTE 16960000 DC X'10' 16970000 LNNO EQU @DATA+00001396 FULLWORD INTEGER 16980000 CHNO EQU @DATA+00001400 4 BYTE(S) 16990000 ORG @DATA+00001404 17000000 TABLE EQU * 10 BYTE(S) 17010000 DC C'0123456789' 17020000 ORG @DATA+00001416 17030000 DBWD EQU * 8 BYTE(S) ON DWORD 17040000 DC X'0000000000000000' 17050000 FWORD EQU @DATA+00001424 4 BYTE(S) ON WORD 17060000 CR EQU 00000002 FULLWORD POINTER REGISTER 17070000 COL EQU 00000000 7 BYTE(S) 17080000 PR EQU 00000003 FULLWORD POINTER REGISTER 17090000 IMAGE EQU 00000000 56 BYTE(S) 17100000 WR EQU 00000004 FULLWORD POINTER REGISTER 17110000 DTST EQU 00000000 FULLWORD INTEGER 17120000 I EQU @DATA+00001428 FULLWORD INTEGER 17130000 J EQU @DATA+00001432 FULLWORD INTEGER 17140000 LENGTH EQU @DATA+00001436 FULLWORD INTEGER 17150000 @SAV007 EQU @DATA+00001440 72 BYTE(S) ON WORD 17160000 PARMR EQU 00000001 FULLWORD INTEGER REGISTER 17170000 DEVR EQU 00000002 FULLWORD INTEGER REGISTER 17180000 @SAV008 EQU @DATA+00001512 72 BYTE(S) ON WORD 17190000 @SAV009 EQU @DATA+00001584 72 BYTE(S) ON WORD 17200000 @SAV011 EQU @DATA+00001656 72 BYTE(S) ON WORD 17210000 ORG @DATA 17220000 DS 00001728C 17230000 @TEMPS DS 0F 17240000 @DATEND EQU * 17250000 @9D5 EQU INPUT730 17260000 IO990 EQU @EL11 17270000 END ICAPRTBL,(C'PL/S',1400,73051) 17280000