* /* START OF SPECIFICATIONS *** * 00002002 *01* PROCESSOR = ASSEM; * 00004002 **** END OF SPECIFICATIONS ***/ * 00006002 TITLE 'IEHINITT-IEHINITT ROOT MODULE' 00010014 * TITLE: M2840 00020002 * 'IEHINITT: TAPE LABELING UTILITY PROGRAM' M2840 00030002 * STATUS: M2840 00040002 * CHANGE LEVEL 000 M2840 00050002 * FUNCTION/OPERATION: M2840 00052002 * THIS ROUTINE EXAMINES THE INITT CONTROL CARD AND BUILDS AN M2840 00060002 * IMAGE IN CORE OF THE LABEL TO BE PUT ON THE USER'S TAPE. M2840 00080002 * IT ALSO KEEPS TRACK OF THE NUMBER OF TAPES THAT ARE TO BE M2840 00100002 * LABELED AND CALLS THE SVC FOR EACH TAPE INCREMENTING THE M2840 00120002 * VOLUME SERIAL NUMBER BY ONE EACH TIME THE SVC IS CALLED M2840 00132002 * FOR A SINGLE LABEL GROUP. M2840 00140002 * THIS ROUTINE DETERMINES AND CONSTRUCTS THE VOLUME HEADER S20038 00142020 * LABEL AS AN OS/360 STANDARD LABEL OR AS AN ASCII STANDARD S20038 00144020 * LABEL. THE DUMMY HEADER LABEL IS THEN CONSTRUCTED IN S20038 00146020 * CONTIGUOUS STORAGE TO THE VOLUME LABEL. THIS LABEL GROUP S20038 00148020 * IS THEN TRANSLATED FROM EBCDIC TO ASCII, IF SPECIFIED BY S20038 00150020 * THE USER, BEFORE CALLING THE TAPE LABELING SVC. S20038 00152020 * ENTRY POINTS: 00154002 * IEHINITT IS THE ONLY ENTRY POINT. IT IS ENTERED TO 00170002 * SET UP A PARAMETER LIST FOR LABELING TAPES 00180002 * INPUT: 00200002 * THERE IS NO INPUT PASSED IN REGISTERS. IT IS THE CONTROL 00210002 * CARDS IN THE CARD READER THAT WILL INDICATE HOW MANY AND HOW 00220002 * THE TAPES ARE LABELED 00240002 * OUTPUT: 00260002 * OUTPUT IS THE TAPES THAT HAVE BEEN SUCCESSFULLY LABELED 00270002 * EXTERNAL ROUTINES: 00272002 * IEHSCAN - SCAN ROUTINE. SCANS CARD INPUT IMAGE IN 00280002 * CORE FOR OPTIONS SPECIFIED 00300002 * IEHPRNT - PRINT ROUTINE. PRINTS OUT CARDS AND ERROR 00320002 * MESSAGES. ALSO PUT HEADING AND PAGE NUMBERS ON EACH PAGE 00340002 * SVC 39 - WRITES A LABEL GROUP ON A TAPE S20038 00342020 * GETMAIN - REQUESTS CORE STORAGE FOR WORK AREA S20038 00344020 * OPEN - OPENS READ AND PRINT DATA SETS S20038 00346020 * RDJFCB - READS JOB FILE CONTROL BLOCK FOR DENSITY S20038 00348020 * XLATE - ISSUES TRANSLATE SVC FOR ASCII OR EBCDIC CODE S20038 00350020 * CLOSE - CLOSES READ AND PRINT DATA SETS S20038 00352020 * FREEMAIN - RELEASES CORE STORAGE FOR WORK AREA S20038 00354020 * EXITS-NORMAL: 00360002 * CONTROL IS RETURNED TO THE CALLER WITH ALL REGS AS THEY 00370002 * WERE WHEN THE UTILITY WAS CALLED 00380002 * EXITS, ERROR: 00390002 * EXIT IS THE SAME AS ABOVE EXCEPT PREVIOUS TO EXIT AN 00400002 * ERROR MESSAGE HAS BEEN PRINTED OUT 00420002 * THE RETURN CODE IN REGISTER 15 INDICATES THE SEVERITY OF 00430002 * THE ERROR 00432002 * TABLES/WORK AREAS: 00434002 * THE WORK AREA CONTAINS A CARD IMAGE, TAPE LABEL 00440002 * IMAGE, ERROR MESSAGES AND SWITCHES 00460002 * THIS AREA IS OBTAINED WITH AN UNCONDITIONAL GETMAIN AND 00470002 * IS SHARED BY IEHINITT, IEHSCAN, AND IEHPRNT 00472002 * ATTRIBUTES: 00474002 * REENTRANT 00480002 * CHARACTER CODE DEPENDENCY - S20038 00480820 * THE OPERATION OF THE SECTION, 'CHECK', WHICH VERIFIES THE S20038 00481620 * SERIAL NUMBER, DEPENDS UPON A CLASSIFICATION OF THE S20038 00482420 * EXTERNAL CHARACTER SET BY MEANS OF A TABLE. THE TABLE IS S20038 00483220 * CONSTRUCTED FOR THE EBCDIC CHARACTER SET AND IS ARRANGED SO S20038 00484020 * THAT REDEFINITION OF ALL 'CHARACTER' CONSTANTS, BY REASSEM- S20038 00484820 * BLY, WILL RESULT IN A CORRECT TABLE FOR THE NEW DEFINITIONS S20038 00485620 * IF THE EXTERNAL CHARACTER SET REMAINS UNCHANGED. S20038 00486420 * INSTRUCTIONS FOR MODIFYING THE TABLE TO ADD, DELETE, OR S20038 00487220 * CHANGE THE MEANING OF CHARACTERS ARE CONTAINED WITH THE S20038 00488020 * TABLE LOCATED IN THE 'CONSTANTS' SECTION. S20038 00488820 IEHINITT CSECT 00490014 * 008600,064000 A25710 00495018 * 071600-071800,073400,081500,112400 A23445 00500018 *0251 1599 00520018 *0251030000,075600-076400 3260 00540018 * M3286 00550019 * 032200,032800,049400-050200,051400-05220,053200-053400, S20038 00552020 * 059200-060200,063600-063800,064800-065200,058000-058200, S20038 00554020 * 058600,112800,112920,124920,127800,128200,131800,141360,144000 S20038 00556020 * 032600,117000-117800,129000-131800,085000 00558020 *A083310 A38606 00559020 *C 146260 M6029 00559420 *A 125161 @ZA01679 00559502 *C 008400 @ZA01679 00559602 *C 017830,018000 @ZA01680 00559702 *C 021400,022600 @ZA01744 00559899 *C 094600 @ZA04374 00559903 *A135684-135692,135701-135708 @ZA16491 00569999 *C135678,135700,135710 @ZA16491 00571999 IEHINIT SAVE (14,12),T,IEHINITT-OZ16491 SAVE REGS @ZA16491 00573399 LR INITBASE,REG15 LOAD IEHINITT BASE REG M2840 00580002 USING IEHINIT,INITBASE ESTABLISH ADDRESSIBILITY M2840 00600002 USING IEHINIT2,MSGBASE ADDRESSABILITY FOR CSECT2 M2840 00610002 GETMAIN R,LV=0+LAST-FIRST GET WORK AREA M2840 00620002 SR UCBSEQ,UCBSEQ KEEP THE M2840 00625002 * SEQUENCE NUMBER OF 15673 00630017 * THE UCB BEING USED. 15673 00635017 LR GOTTEN,REG1 SAVE ADDRESS OF WORK AREA M2840 00640002 * 00660000 * THIS SECTION CLEARS OUT THE GETMAIN AREA AND 00680000 * INITIALIZE THE LABEL FIELD TO THE DEFAULT OPTIONS 00700000 * RELATED TO THE ITITT CARD 00720000 * 00740000 MVI 0(REG1),BINZERO ZERO OUT THE WORK AREA M2840 00760002 LA REG2,ABS255 GET LENGTH OF 255 M2840 00780002 LA REG3,0+LAST-FIRST GET LENGTH OF WORK AREA M2840 00800002 BCTR REG3,REG0 SUB FIRST BYTE CLEARED M2840 00810002 EXEC EX REG2,MVZO CLEAR 255 BYTES M2840 00820002 LA REG1,ABS256(REG1) BUMP REG 1 BY 256 @ZA01679 00840002 S REG3,TWO56 SIZE OF AREA NOT CLEAR M2840 00860002 C REG3,TWO55 LESS THAN 255 BYTES? M2840 00880002 BC 2,EXEC NO, GO CLEAR 255 BYTES M2840 00900002 EX REG3,MVZO CLEAR REMAINDER OF BYTES M2840 00920002 USING WORK,GOTTEN SET UP ADDRESSIBILITY FOR M2840 00940002 * WORK AREA 00960000 ST REG13,SAVE+DSP4 SAVE CALLER'S REG 13 M2840 00980002 * 01000000 * 01020000 LA STWREG,PRINT GET ADDRESS OF PRINT DCB M2840 01040002 ST STWREG,PRINTAD SAVE IT FOR EXECUTE OPEN M2840 01060002 MVI PRINTAD,OPENOUT SET END-OF-LIST, OUTPUT M2840 01080002 LA STWREG,LBLDCB DUMMY ADDR OF JFCB DCB M2840 01085002 ST STWREG,AGO SAVE FOR EXECUTE, RDJFCB M2840 01090002 MVI AGO,ENDLIST SET END-OF-LIST, RDJFCB M2840 01095002 LA STWREG,READ GET ADDRESS OF READ DCB M2840 01100002 ST STWREG,READAD SAVE IT FOR EXECUTE OPEN M2840 01120002 MVI READAD,ENDLIST END-OF-LIST, INPUT M2840 01140002 MVC PRINT(L'PRINT),PRINT1 COPY PRNT DCB TO WORK AREA M2840 01160002 MVC READ(L'READ),READ1 COPY READ DCN TO WORK AREA M2840 01180002 EJECT 01182002 * M2840 01190002 * CHECK TO SEE IF ANY PARAMETERS WERE PASSED TO M2840 01192002 * IEHINITT BY LINK OR ATTACH, OR BY THE PARM M2840 01194002 * FIELD OF THE EXEC STATEMENT. M2840 01194402 * M2840 01196002 INVOC L REG13,SAVE+DSP4 PICK UP PARAMETER LIST PTR M2840 01200002 L REG1,L24(REG13) PASSED WHEN INVOKED M2840 01220002 SR REG3,REG3 CLEAR WORK REGISTER M2840 01240002 C REG3,0(REG1) ARE ANY OPTIONS SPECIFIED 01260000 BE NOOPT BRANCH IF NO OPTIONS M2840 01280002 L REG2,0(REG1) PICK UP POINTER TO OPTION 01300000 * PARAMETER LIST 01320000 CLC 0(TWO,REG2),ZERO IS LIST LENGTH ZERO? M2840 01340002 BC 8,NOOPT BRANCH IF LENGTH IS ZERO 01380000 * M2840 01390002 * THE OPTIONADDR PARAMETER WAS SPECIFIED. ITS M2840 01392002 * LENGTH MUST BE 10 BYTES, THE FIRST 8 BYTES M2840 01392402 * MUST CONTAIN 'LINECNT=', AND THE LAST TWO M2840 01392802 * BYTES MUST BE NUMERIC. M2840 01393202 * M2840 01394002 LH REG3,0(REG2) LENGTH OF OPT PARM LIST M2840 01400002 CH REG3,MAXCT LENGTH OF LINECNT PARM=10? M2840 01406002 BNE MESSAGE1 BRANCH IF INVALID LENGTH M2840 01412002 LNCNT CLC TWO(L'LINCT,REG2),LINCT IS PARAMETER 'LINECNT=' M2840 01660002 BNE MESSAGE1 BRANCH IF INVALID PARM M2840 01680002 FOUND XC HERE(LNG8),HERE CLEAR USED WORK AREA M2840 01780002 MVC HERE(TWO),10(REG2) MOVE IN LINECNT @ZA01680 01783002 NC HERE+ONE1(ONE1),HERE S20038 01786020 TM HERE+ONE1,FOXZERO TEST FOR NUMERICS S20038 01789002 BNO MESSAGE1 BRANCH IF NOT NUMERICS S20038 01792020 XC HERE(TWO),HERE RESTORE AREA S20038 01795020 PACK HERE+DSP6(TWO),10(TWO,REG2) GET LINES @ZA01680 01800002 CVB STWREG,HERE CONVERT LINES TO BINARY M2840 01820002 B LASTP GO STORE PASSED LINE COUNT M2840 01880002 MESSAGE1 OI PARMERR,BIT7 SET LINECOUNT ERROR FLAG M2840 01890002 NOOPT LA STWREG,ABS60 SET DEFAULT LINES TO 60 M2840 01900002 LASTP STH STWREG,LINETOT TOTAL LINES PER PAGE M2840 01920002 STH STWREG,LINELEFT LINES LEFT YET TO PRINT M2840 01940002 TM 0(REG1),ENDLIST TEST FOR LAST PTR IN LIST M2840 01960002 BO NONAMES BRANCH IF LAST M2840 01980002 * M2840 01990002 * THE DDNAMEADDR PARAMETER WAS SPECIFIED. CHECK M2840 01992002 * ENTRIES 5 AND 6 FOR ALTERNATE NAMES FOR M2840 01994002 * SYSIN AND SYSPRINT RESPECTIVELY. IF M2840 01996002 * ALTERNATE NAMES ARE PRESENT, PUT THOSE M2840 01998002 * NAMES INTO THE READ AND PRINT DCB'S. M2840 01998402 * M2840 01998802 NAME L REG2,DSP4(REG1) PICK UP POINTER TO DDNAMES M2840 02000002 CLC 0(L'FIVE,REG2),FIVE IS EITHER SYSIN OR M2840 02020002 * SYSPRINT SPECIFIED M2840 02040002 BL NONAMES BRANCH, NEITHER SPECIFIED M2840 02060002 CLC D34(LNG8,REG2),ZERO POSITION BINARY ZEROS? M2840 02100002 BE NOINNAME BRANCH IF NOT SPECIFIED M2840 02120002 MVC RDDNAME,D34(REG2) FILL DDNAME IN DCB @ZA01744 02140099 PRNAME CLC 0(L'SIX,REG2),SIX LNGTH PRESENT FOR SYSPRINT M2840 02160002 BC 4,NOPRNAME NO, USE DEFAULT NAME M2840 02180002 CLC D42(LNG8,REG2),ZERO SUBSTITUTE NAME SPECIFIED? M2840 02220002 BE NOPRNAME NO, USE DEFAULT NAME M2840 02240002 MVC PDDNAME,D42(REG2) YES, MOVE DDNAME INTO DCB @ZA01744 02260099 B LASTDDNM GO BEGIN CHECK FOR PAGE M2840 02280002 NOINNAME MVC RDDNAME,SYSIN FILL IN DEFAULT FOR SYSIN M2840 02360002 B PRNAME SEE IF NAME FOR SYSPRINT M2840 02380002 NONAMES MVC RDDNAME,SYSIN FILL IN DEFAULT FOR SYSIN M2840 02390002 NOPRNAME MVC PDDNAME,SYSPRINT FILL DEFAULT FOR SYSPRINT M2840 02400002 * M2840 02410002 * PICK UP PAGE NUMBER IF HDINGADDR SPECIFIED. M2840 02412002 * IF NOT SPECIFIED, START WITH PAGE 1. M2840 02414002 * M2840 02416002 LASTDDNM TM 0(REG1),ENDLIST MORE OPTIONS SPECIFIED? M2840 02420002 BO DFALT NO MORE POINTERS M2840 02440002 TM DSP4(REG1),ENDLIST MORE OPTIONS SPECIFIED? M2840 02460002 BO DFALT NO MORE POINTERS M2840 02480002 PAGE L REG2,DSP8(REG1) POINT AT PAGE NUMBER AREA M2840 02500002 CLC 0(TWO,REG2),ZERO IS PAGE NUMBER SPECIFIED M2840 02520002 BE DFALT NO PAGE NUM, TAKE DEFAULT M2840 02540002 CVT XC HERE(LNG8),HERE CLEAR USED PART OF WORKA M2840 02620002 MVC HERE(LNG4),TWO(REG2) MOVE IN PAGECNT S20038 02622020 NC HERE+ONE1(LNG3),HERE S20038 02624020 TM HERE+LNG3,FOXZERO TEST FOR NUMERICS M2840 02626002 BNO MESSAGE2 BRANCH IF NOT NUM S20038 02628020 CLC LNG0(TWO,REG2),FOUR1 PAGECNT CORRECT LENGTH? S20038 02630020 BNE MESSAGE2 BRANCH IF INCORRECT S20038 02632020 XC HERE(LNG4),HERE RESTORE AREA S20038 02634020 PACK HERE+DSP5(LNG3),TWO(LNG4,REG2) M2840 02640002 CVB STWREG,HERE CONVERT PAGE NO TO BINARY M2840 02660002 B OUT GO STORE PAGE NUMBER M2840 02662002 MESSAGE2 OI PARMERR,BIT7 SET PAGECOUNT ERROR FLAG M2840 02664002 DFALT LA STWREG,ABS1 DEFAULT OPTION IS PAGE ONE M2840 02670002 OUT STH STWREG,PAGENUM SAVE STARTING PAGE NUMBER M2840 02680002 EJECT 02690002 * M2840 02692002 * OPEN SYSIN AND SYSPRINT (OR SUBSTITUTES) M2840 02694002 * M2840 02696002 LA REG13,SAVE PTR TO IEHINITT SAVE AREA M2840 02700002 MVI DFLG,NULL INITIALIZE ERROR FLAGS M2840 02706002 MVI DFLAG,NULL M2840 02712002 OPEN MF=(E,PRINTAD) EXECUTE OPEN CODE STORED IN WORK 02720000 * AREA FOR PRINTER 02740000 LA REG13,SAVE PTR TO IEHINITT SAVE AREA M2840 02760002 OPEN MF=(E,READAD) EXECUTE OPEN CODE STORED IN WORK 02780000 * AREA FOR READER 02800000 LA STWREG,JFCBLST MOVE EXLST ADDR INTO DCB M2840 02960002 ST STWREG,JFLSTAD M2840 02980002 MVC GO+ONE1(LNG3),JFLSTAD+ONE1 MOVE EXLST TO SAVE AREA M2840 02990002 * M2840 03017102 * CALL IEHPRNT TO PRINT FIRST PAGE HEADING M2840 03017402 * M2840 03017802 LA REG13,SAVE PTR TO IEHINITT SAVE AREA M2840 03020002 LA REG12,COMTAB PTR TO WORK AREA M2840 03030002 LINK EP=IEHPRNT GO PRINT HEADING M2840 03060002 C REG15,ZERO IS RETURN CODE ZERO M2840 03080002 BNE RETURN BRANCH, CODE NOT ZERO M2840 03100002 TM PARMERR,BIT7 TEST FOR LINECNT OR M2840 03105002 * PAGECNT ERROR S20038 03110020 BO MESSAGE BRANCH IF ERROR S20038 03115020 SKIPRINT TM ROPENFLG,BADOPEN OPEN READ DCB SUCCESFUL M2840 03120002 BZ BAD BRANCH IF NO M2840 03140002 TM DFLAG,BADOPEN SYSIN BLKSIZE ERROR FLAG M2840 03146002 BO BAD BRANCH IF ERROR M2840 03152002 MVI RC,NULL INITIALIZE RETURN CODE M2840 03156002 EJECT 03158002 REDO MVI LABEL,BLANKCOL INITIALIZE LABEL TO BLANKS M2840 03160002 MVC LABEL+ONE1(L79),LABEL CLEAR REMAINDER OF LABEL M2840 03180002 MVC LABEL(L'VLM),VLM MOVE CONSTANT 'VOL1' M2840 03200002 MVI NUMTPS,BIT7 DEFAULT OPTION FOR NUMBER M2840 03240002 NI KEY,NULL TURN OFF ALL KEYWORD BITS M2840 03310002 NI SWITCHAL,NULL CLEAR ASCII LABEL SWITCH S20038 03315020 OC SVCLST(L'UNLD),UNLD DET DEFAULT TO UNLOAD M2840 03320002 LA STWREG,HOMEJFCB PICK UP ADDR OF JFCB AREA M2840 03340002 ST STWREG,JFCBLST SAVE IT FOR JFCB READ M2840 03380002 MVI JFCBLST,ENDJFCB SET END-OF-LIST, JFCB M2840 03390002 L STWREG,ABS16 PICK UP CVT ADDRESS M2840 03400002 L REG5,0(STWREG) PICK UP DOUBLE WORD M2840 03420002 * CONTAINING TCB ADDRESS M2840 03440002 L STWREG,DSP4(REG5) PICK UP TCB ADDRESS M2840 03460002 ST STWREG,TCB SAVE TCB PTR JUST FOUND M2840 03480002 MVI SWITCHRD,NULL CLEAR SWITCHRD INDICATING M2840 03500002 * FIRST ENTRY M2840 03520002 EJECT 03530002 SCAN1 LA REG13,SAVE PTR TO IEHINITT SAVE AREA M2840 03540002 LA REG12,WORK PTR TO COMMON WORK AREA M2840 03550002 SCAN LINK EP=IEHSCAN 03580000 * 03600000 * THE FOLLOWING ROUTINE CHECKS FOR SUCCESS OF THE 03620000 * SCAN AND ALSO CHECKS TO SEE IF A DDNAME,COMMAND 03640000 * WORD, KEYWORD OR PARAMETER IS RETURNED 03660000 * 03680000 TM DISP11,BIT7 SYNAD ENTERED IN IEHSCAN M2840 03710002 BO BAD YES,BR. 9837 03715014 TM SWITCHRD,BIT0 IS ERROR BIT ON M2840 03720002 BNO DNAM NO, SEE WHAT WAS PASSED M2840 03740002 ERR BAL REG14,ERRMSG ERROR MESSAGE SET UP M2840 03790002 MVC MSGTEXT(L'ERR1),ERR1 INVALID STATEMENT MSG TEXT M2840 03800002 ERRPTR MVI RC,RCODE08 SET RETURN CODE TO 8 M2840 03820002 LINK EP=IEHPRNT 04000000 C REG15,ZERO IS RETURN CODE ZERO M2840 04020002 BNE RETURN RETURN CODE NOT ZERO M2840 04040002 NEXT TM SWITCHRD,BIT2 IS END OF FILE BIT ON 04060000 BO RETURN BRANCH ON YES M2840 04080002 TM SWITCHRD,BIT1 IS BYPASS BIT ON M2840 04130002 BO REDO YES, SET UP FOR NEXT GROUP M2840 04180002 B SCAN1 JUST READ AND PRINT CARDS M2840 04230002 EJECT 04262002 * M2840 04270002 * IEHSCAN SAVES THREE VALUES IN THE COMMON WORK M2840 04272002 * AREA BEFORE RETURNING TO IEHINITT. THESE M2840 04274002 * VALUES ARE: M2840 04276002 * PARMPTR - THE ADDRESS OF THE FIRST M2840 04278002 * POSITION IN CARD FOR THE VALUE M2840 04278402 * PASSED. M2840 04278802 * LNGPARM - THE LENGTH OF THE VALUE PASSED M2840 04279202 * DISP12 - THE ADDRESS OF THE LAST M2840 04279602 * POSITION SCANNED M2840 04279702 * M2840 04279802 DNAM L REG1,PARMPTR STARTING COLUMN M2840 04279902 L REG2,LNGPARM LENGTH OF SCAN M2840 04286602 L REG3,DISP12 LAST COLUMN SCANNED M2840 04288602 TM DISP10,BIT5 TEST FOR DDNAME BIT ON M2840 04293302 BC NO,COMDWRD SEE IF COMMAND WORD M2840 04300002 MVI DDNAM,BLANKCOL CLEAR DDNAME FIELD M2840 04320002 MVC DDNAM+ONE1(LNG7),DDNAM CLEAR DDNAME FIELD M2840 04340002 C REG2,EIGHT DDNAME LONGER THAN 8 M2840 04346002 BH ERR YES, ERROR M2840 04352002 BCTR REG2,REG0 DECREASE LENGTH BY 1 M2840 04360002 EX REG2,DDMVE MOVE DDNAME TO SAVE AREA M2840 04380002 CLC DDNAM,LASTDD IS DDNAM SAME AS BEFORE? M2840 04386002 BE THRU IF SO, DON'T REINITIALIZE M2840 04392002 SR UCBSEQ,UCBSEQ IF NOT, DO REINITIALIZE M2840 04398002 MVC LASTDD,DDNAM SAVE NEW 'DDNAM'. M2840 04404002 B THRU GO HOUSEKEEP M2840 04420002 COMDWRD TM SWITCHRD,BIT4 TEST FOR COMMAND WORD BIT 04440000 BZ KEYWRD NOT COMMAND WORD, BRANCH M2840 04460002 CHKCOM CLC INITT,0(REG1) IS COMMAND WORD CORRECT M2840 04470002 BE THRU THE OPERATION IS 'INITT' M2840 04472002 OI SWITCHRD,BIT1 SET ON BYPASS SWITCH 04472402 B ERR BAD COMMAND WORD, ERROR M2840 04474002 EJECT 04476002 KEYWRD TM SWITCHRD,BIT5 TEST FOR KEYWORD BIT M2840 04480002 BNO PARM NOT KEYWORD, BRANCH M2840 04500002 * M2840 04510002 * THE FOLLOWING FIVE TESTS (SERL, DISPL, OWNR, M2840 04512002 * NUMBTAPE, AND LABTYP) TEST FOR VALID M2840 04514002 * KEYWORDS. IF THE KEYWORD IS NOT ONE OF THE M2840 04516002 * SPECIFIED KEYWORDS, A BRANCH IS MADE TO M2840 04518002 * 'WRONG' TO SET UP 'INVALID KEYWORD' ERROR M2840 04518402 * MESSAGE. M2840 04518802 * M2840 04519202 SERL CLC SER,0(REG1) IS KEYWORD SERIAL NUMBER? M2840 04520002 BNE DISPL NO, KEYWORD NOT SERIAL NO. M2840 04600002 OI KEY,BIT0 TURN ON SERIAL NUMBER BIT 04620000 B SCAN1 RETURN TO SCAN FOR PARM M2840 04660002 DISPL CLC DISP,0(REG1) IS KEYWORD DISPOSITION M2840 04740002 BNE OWNR NO, KEYWORD NOT DISP M2840 04780002 OI KEY,BIT1 TURN ON DISP BIT 04800000 B SCAN1 RETURN TO SCAN FOR PARM M2840 04820002 OWNR CLC OWNRN,0(REG1) IS KEYWORD OWNER? M2840 04840002 BC 7,NUMBTAP BRANCH ON NO TO NEXT CHK S20038 04880020 OI KEY,BIT2 TURN ON OWNER NAME BIT 04900000 B SCAN1 RETURN TO SCAN FOR PARM M2840 04920002 NUMBTAP CLC NUMBTAPE,0(REG1) KEYWORD NUMBTAPE? M2840 05040002 BC 7,LABTYP IF NO,BRANCH TO NEXT CHK S20038 05080020 OI KEY,BIT4 TURN ON NUMBTAPE BIT 05100000 B SCAN1 RETURN TO SCAN FOR PARM M2840 05120002 LABTYP CLC LABTYPE,0(REG1) IS KEYWORD LABTYPE? M2840 05130002 BC 7,WRONG IF NO,BRANCH TO ERROR RTN S20038 05210020 OI KEY,BIT6 TURN ON LABTYPE BIT S20038 05220020 B SCAN1 RETURN TO SCAN FOR PARM M2840 05230002 WRONG BAL REG14,ERRMSG ERROR MESSAGE SET UP M2840 05270002 MVC MSGTEXT(L'ERR2),ERR2 INVALID KEYWORD MSG TEXT M2840 05280002 OI SWITCHRD,BIT1 SET ON BYPASS SWITCH 05290002 B ERRPTR GO PRINT ERROR MSG M2840 05300002 EJECT 05350002 PARM TM SWITCHRD,BIT6 IS THIS A PARAMETER 05360000 BO CHECK YES, HANDLE AS PARAMETER M2840 05380002 TM SWITCHRD,BIT1 TEST BYPASS BIT M2840 05400002 BC 1,COL72B BRANCH IF ON M2840 05420002 B EOF GO SET UP FOR NEXT GROUP M2840 05440002 * M2840 05450002 * THE FOLLOWING FIVE TESTS (CHECK, CHKDISP, M2840 05452002 * CHKOWNR, CHKNUMTP, AND CHKLAB) TEST FOR M2840 05454002 * VALID PARAMETERS. IF THE PARAMETER DOES M2840 05456002 * NOT MEET THE SPECIFIED REQUIREMENTS, A M2840 05458002 * BRANCH IS MADE TO 'BADPARM' TO SET UP M2840 05458402 * 'INVALID PARAMETER VALUE' ERROR MESSAGE M2840 05458802 * M2840 05459202 CHECK TM KEY,BIT0 IS SER # BIT ON 05460000 BC 8,CHKDISP IF NO BRANCH 05480000 STM REG1,REG3,MYSAVE SAVE ALL REGISTERS M2840 05482002 LR REG3,REG1 REG3 CONTAINS ADDR OF I/P M2840 05484002 TRT 0(LNG7,REG3),TABLE TEST LEGAL CHARACTERS M2840 05486002 S REG1,MYSAVE NO. OF CHARACTERS SEARCHED M2840 05488002 C REG1,MYSAVE+DSP4 NO OF CHARACTERS CHANGED? M2840 05490002 BNE BADPARM YES, GO TO ERROR ROUTINE S20038 05492020 LM REG1,REG3,MYSAVE RESTORE SAVED REGISTERS M2840 05494002 MVI SERIAL,BLANKCOL CLEAR FIRST BYTE OF SERIAL M2840 05500002 MVC SERIAL+ONE1(LNG5),SERIAL CLEAR REMAINDER OF SERIAL M2840 05520002 LA STWREG,L'SERIAL GET LENGTH OF SERIAL M2840 05530002 CR REG2,STWREG IS PARAMETER TOO LONG M2840 05532402 BH BADPARM YES, SET UP PARAMETER ERR M2840 05534002 BCTR REG2,REG0 DECREASE LENGTH BY 1 M2840 05540002 EX REG2,MOVSER MOVE SERIAL TO LABEL AREA M2840 05560002 B THRU VALID SERIAL PARM, CONT. M2840 05600002 CHKDISP TM KEY,BIT1 IS DISP BIT ON 05620000 BC 8,CHKOWNR IF NO BRANCH 05640000 CLC REWIND,0(REG1) IS THE DISP REWIND M2840 05680002 BNE THRU NO, ASSUME REWIND-UNLOAD M2840 05700002 RE MVC SVCLST(L'RWND),RWND SET FOR REWIND OPTION M2840 05720002 B THRU VALID DISP. PARM, CONTINUE M2840 05740002 CHKOWNR TM KEY,BIT2 IS OWNER NAME BIT ON 05760000 BC 8,CHKNUMTP BRANCH ON NO S20038 05768020 LTR REG2,REG2 IS PARM LENGTH EQ ZERO S20038 05776020 BZ BADPARM BRANCH IF ZERO S20038 05784020 C REG2,FOURTEEN IS OWNER NAME G.T. 14 S20038 05800002 BH BADPARM BRANCH ON YES S20038 05808020 OI SWITCHAL,OWNRSW FLAG OWNERID SPECIFIED S20038 05816020 ST REG2,OWNRLNG SAVE LENGTH FOR LATER CHK S20038 05824020 BCTR REG2,REG0 DECREASE LENGTH BY 1 M2840 05840002 EX REG2,ONAMHOLD HOLD OWNER FOR LATER CHK S20038 05860020 B THRU VALID OWNER PARM, CONT M2840 05900002 * M2840 05950002 * THE NUMBER OF TAPES CAN RANGE FROM 1 TO 3 M2840 06000002 * BYTES (1 TO 255 TAPES) AND THE LOCATION FOR M2840 06010002 * THE PACK INSTRUCTION MUST VARY ACCORDINGLY M2840 06020002 * M2840 06030002 CHKNUMTP TM KEY,BIT4 IS NUMBTAPE BIT ON 06040000 BZ CHKLAB NOT NUMBTAPE PARM, BRANCH M2840 06060002 C REG2,FTHREE MORE THAN THREE DIGITS M2840 06070002 BH BADPARM YES, SET UP PARAMETER ERR M2840 06072002 XC THERE(LNG3),THERE CLEAR AREA FOR NUMB TAPES M2840 06080002 LA STWREG,THERE+TWO POINT AT LOW-ORDER BYTE M2840 06120002 BCTR REG2,REG0 DECREASE PASSED LNGTH BY 1 M2840 06160002 SR STWREG,REG2 IF NUMBER OF TAPES GREATER M2840 06180002 * THAN SINGLE DIGIT, M2840 06192002 * ADJUST MVC START COL. M2840 06194002 EX REG2,TAPENUM MOVE PARM TO AREA 'THERE' M2840 06200002 XC HERE(LNG8),HERE CLEAR PART OF WORK AREA M2840 06240002 PACK HERE+DSP6(TWO),THERE(LNG3) 06260002 CVB STWREG,HERE CONVERT NO OF TAPES M2840 06280002 STC STWREG,NUMTPS STORE NUMBER OF TAPES M2840 06300002 NI KEY,NULL TURN OFF NUMBTAPE BIT M2840 06320002 CLI NUMTPS,NULL CHECK FOR NO TAPE M2840 06326002 BC 8,BADPARM BRANCH ON YES A25710 06332018 B THRU VALID NUMBTAPE PARAM, CONT M2840 06340002 CHKLAB TM KEY,BIT6 IS LABTYPE BIT ON S20038 06344020 BZ BADPARM NOT LABTYPE PARM, BRANCH M2840 06348002 LA STWREG,L'AL GET LENGTH OF 'AL' M2840 06358002 CR REG2,STWREG IS PARAMETER TOO LONG M2840 06368002 BH BADPARM YES, SET UP PARAMETER ERR M2840 06370002 CLC AL(L'AL),0(REG1) IS PARM EQUAL TO 'AL' M2840 06372002 BNE BADPARM BRANCH ON NO S20038 06376020 OI SWITCHAL,ASCIISW FLAG ASCII LAB SPECIFIED S20038 06384020 B THRU VALID LABTYPE PARM, CONT. M2840 06388002 BADPARM BAL REG14,ERRMSG ERROR MESSAGE SET UP M2840 06430002 MVC MSGTEXT(L'ERR3),ERR3 INVALID PARAMETER TEXT M2840 06440002 B ERRPTR GO SET UP TO CALL IEHPRNT M2840 06460002 EJECT 06470002 THRU MVI KEY,NULL RESET KEYWORD FLAG M2840 06510002 TM SWITCHRD,BIT1 IS THE BYPASS SWITCH ON 06540002 BZ SCAN1 BRANCH IF NO S20038 06700002 COL72B MVI SWITCHRD,NULL CLEAR SWITCH BYTE M2840 06720002 CLI SERIAL,BLANKCOL IS SERIAL NUMBER SPECIFIED M2840 06760002 BC 8,ERR BRANCH IF NO SER NUMBER IS 06780000 * SPECIFIED 06800000 TM SWITCHAL,ASCIISW IS ASCII LABEL SPECIFIED S20038 06801020 BNO NONASCII BRANCH ON NO S20038 06802020 TM SWITCHAL,OWNRSW IS OWNER NAME SPECIFIED S20038 06803020 BNO ASCISEC BRANCH ON NO S20038 06804020 NI SWITCHAL,OWNEROFF TURN OFF OWNER BIT S20038 06805020 L STWREG,OWNRLNG SETUP MOVE FOR OWNER M2840 06806002 BCTR STWREG,REG0 SET UP MVC LENGTH M2840 06807002 EX STWREG,ONAMASCI MOVE ASCII OWNER TO LABEL M2840 06808002 ASCISEC MVI SECURITY,BLANKCOL ASCII SECURITY DFLT=SPACE M2840 06809002 MVI LABEL+DSP79,ASCIISTD ASCII LABEL STANDARD=1 S20038 06810002 B TIOTPTR GO GET TIOT PTR M2840 06811002 NONASCII TM SWITCHAL,OWNRSW IS OWNER NAME SPECIFIED S20038 06812020 BNO EBCDSEC BRANCH ON NO S20038 06813020 NI SWITCHAL,OWNEROFF TURN OFF OWNER BIT S20038 06814020 CLC OWNRLNG(L'OWNRLNG),TEN IS OWNER NAME G.T. TEN S20038 06815020 BH BADPARM IF YES GO TO ERROR RTN S20038 06816020 L STWREG,OWNRLNG SETUP MOVE FOR OWNER M2840 06817002 BCTR STWREG,REG0 SET UP MVC LENGTH M2840 06818002 EX STWREG,ONAMEBCD MOVE EBCDIC OWNER TO LBL M2840 06819002 EBCDSEC MVI SECURITY,SECURE EBCDIC SECURITY DFLT=0 M2840 06820002 EJECT 06820402 TIOTPTR L STWREG,TCB PICK UP PTR TO THE TIOT M2840 06821002 L REG5,D12(STWREG) NOW CONTAINS PTR TO TIOT M2840 06840002 LA REG5,D24(REG5) START OF TIOT DD ENTRY M2840 06860002 NEXTTIOT SR REG6,REG6 CLEAR WORK REGISTER M2840 06880002 IC REG6,0(REG5) GET LENGTH BYTE IN TIOT M2840 06900002 LTR REG6,REG6 END OF TIOT 06920000 BC 8,ERR NO MATCHING DDNAME, ERROR M2840 06940002 CLC DSP4(LNG8,REG5),DDNAM RIGHT DD NAME M2840 06960002 BE DDTIOT BRANCH IF YES M2840 06980002 AR REG5,REG6 GET NEXT DDNAME M2840 07000002 B NEXTTIOT GO TEST NEXT DDNAME M2840 07020002 DDTIOT S REG6,SIX10 SUB LENGTH OF DD ENTRY(16) M2840 07040002 SRL REG6,2 DIVIDE BY 4 M2840 07060002 STC REG6,UCBNUM 07080000 A REG5,SIX10 POINT TO FIRST UCB POINTER 07100000 SLL REG6,2 A23445 07106018 EX REG6,MVEUCB MOVE UCB PTR INTO PROG A23445 07112018 L REG5,0(REG5) PICK UP UCB POINTER 07120000 ST REG5,TCB SAVE UCB POINTER M2840 07140002 SR REG4,REG4 USE REG 4 TO KEEP COUNT OF BAD 07200000 * UCB POINTERS 07220000 SR REG6,REG6 USE REG 6 TO KEEP COUNT OF THE 07240000 IC REG6,UCBNUM TOTAL NUMBER OF UCB POINTERS 07260000 LA REG5,UCBAREA POINT TO UCB PTRS 07340001 EJECT 07342002 * THIS CODE READS THE JFCB A46764 07350001 * TO DETERMIN IF A A46764 07354001 * VALID DENSITY WAS A46764 07356001 * SPECIFIED OR A DEFAULT A46764 07358001 * IS TO BE TAKEN A46764 07358401 VALRJFCB LA REG13,GPSAVE READ JFCB TO DETERMIN DEN A46764 07390001 MVI GO+12,BIT6 SET DCB TO LOOK UNOPENED M2840 07490002 XC GO+13(3),GO+13 ZERO DCBIFLG AND DCBMACR A46764 07540001 RDJFCB MF=(E,AGO) A46764 07590001 L REG1,TCB POINT TO UCB A46764 07640001 USING UCB,REG1 A46764 07690001 LA REG2,HOMEJFCB POINT TO JFCB A46764 07740001 USING JFCB,REG2 A46764 07790001 * THIS CODE IS USED TO A46764 07810001 * INITIALIZE FLAGS A46764 07830001 MVI VALCOMP,BIT0+BIT1+BIT3 INIT DENSITY WORK AREA Y02128 07840002 MVI VALFLGS,NULL CLEAR VALID WORK FLAGS M2840 07890002 * VALFLGS BITS 0-5 UNUSED A46764 07940001 * X'02' 6 DEFAULTING A46764 07990001 * X'01' 7 DEN IS VALID A46764 08000001 TM JFCDEN,BIT6+BIT7 WILL I DEFAULT ? M2840 08010002 BO VALNODEF B IF A DEN IS SPECIFIED A46764 08020001 OI VALFLGS,BIT6+BIT7 SET DEFAULTING AND NOMSG M2840 08030002 VALNODEF NC VALCOMP,JFCDEN VALDEN=DENSITY BITS ONLY M2840 08032002 * BRANCH TABLE DETERMINES A46764 08032802 * PATH FOR DRIVE A46764 08033001 * SELECTED A46764 08033101 TM UCBTBYT2,UCB2OPT0+UCB2OPT1 IS IT 7 TRK ? M2840 08034002 BNZ VAL7TRK B IF 7 TRK A46764 08036001 OI SWITCHAL,ASCIMODE ASCI IS VALID FOR 9 TRK A46764 08038001 TM UCBTBYT2,UCB2OPT2 IS IT DUAL DENSITY ? M2840 08038402 BO VALDDEN B IF DUAL DEN A46764 08038802 TM UCBTBYT2,X'10' IS IT 1600/6250 BPI? Y02128 08038902 BO VAL6250 BRANCH IF YES Y02128 08039002 TM UCBTYP,UCB1FEA5 IS IT 1600 DEN? Y02128 08039202 BO VALPE B IF 1600 Y02128 08039602 TM UCBTYP,X'02' IS IT 6250 BPI? Y02128 08041602 BZ VAL9ONLY BRANCH IF NOT 6250 Y02128 08043602 MVI SVCLST+15,X'D3' SET 6250 BPI Y02128 08043702 CLI VALCOMP,X'D0' WAS 6250 SPECIFIED? Y02128 08043802 BE VALID B IF 6250 SPECIFIED Y02128 08043902 B VALCK SEE IF I DEFAULTED Y02128 08044502 * THIS CODE FOR 9 TRK ONLY A46764 08046002 VAL9ONLY MVI SVCLST+15,X'AB' MOVE CONST. FOR 9 TRK A46764 08046602 CLI VALCOMP,BIT0 WAS 800 SPECIFIED ? M2840 08048002 BE VALID B IF YES A46764 08050002 B VALCK SEE IF I DEFAULTED A46764 08052002 * THIS CODE FOR DUEL DEN A46764 08054002 VALDDEN MVI SVCLST+15,X'CB' SET 800 BPI A46764 08056002 CLI VALCOMP,BIT0 WAS 800 SPECIFIED ? A46764 08058002 BE VALID B IF IT WAS A46764 08060002 * THIS IS ALSO FOR P.E. A46764 08062002 VALPE MVI SVCLST+15,X'C3' SET 1600 BPI A46764 08064002 CLI VALCOMP,BIT0+BIT1 WAS 1600 SPECIFIED ? M2840 08066002 BE VALID B IF YES A46764 08068002 B VALCK SEE IF I DEFAULTED A46764 08070002 VAL6250 MVI SVCLST+15,X'D3' SET 6250 BPI Y02128 08071702 CLI VALCOMP,X'D0' WAS 6250 SPECIFIED? Y02128 08071802 BE VALID B IF 6250 SPECIFIED. Y02128 08071902 CLI VALCOMP,X'C0' WAS 1600 SPECIFIED? Y02128 08072002 BNE VALCK IF NOT, SEE IF DEFAULT Y02128 08072102 MVI SVCLST+15,X'C3' ELSE SET 1600 BPI Y02128 08072202 B VALID Y02128 08072302 * THIS IS THE 7 TRK CODE A46764 08072402 VAL7TRK MVI SVCLST+15,X'2B' SET 7 TRK MASK A46764 08074002 CLI VALCOMP,BIT0+BIT1 INVALID 1600 SPECIFIED ? M2840 08076002 BE VAL800 B IF YES AND DEFAULT A46764 08078002 OI VALFLGS,BIT7 SET VALID SWITCH M2840 08080002 TM VALFLGS,BIT6 DO I DEFAULT ? M2840 08082002 BO VAL800 IF SO GO DEFAULT A46764 08084002 OC SVCLST+15(1),VALCOMP SET SPECIFIED DENSITY A46764 08086002 B VALCK SEE IF ERROR MSG NEEDED A46764 08088002 VAL800 OI SVCLST+15,BIT0 SET DEN 800 M2840 08090002 * THIS IS THE MSG RTN FOR A46764 08092002 * INVALID DENSITY REQUESTS A46764 08094002 VALCK TM VALFLGS,BIT7 VALID REQUEST ? M2840 08096002 BO VALID SKIP THE ERROR MSG A46764 08098002 MVI RC,RCODE08 SET RETURN CODE TO 8 M2840 08100002 BAL REG14,ERRMSG ERROR MSG SET UP A46764 08102002 MVC MSGTEXT(L'ERRB+L'ERRBC),ERRB MOVE IN MSG M2840 08104002 LINK EP=IEHPRNT LINK TO PRINT RTN A46764 08106002 VALID EQU * A46764 08108002 EJECT 08110002 DROP LA REG1,0(REG1) 08112002 DROP REG1 08114002 DROP REG2 08116002 TM SWITCHAL,ASCIISW IS ASCII LABEL SPECIFIED S20038 08118002 BNO UCBLOOP BRANCH ON NO S20038 08120002 TM SWITCHAL,ASCIMODE IS VALID TAPE MODE SET S20038 08122002 BO TURNOFF BRANCH ON YES S20038 08124002 ASCIIERR BAL REG14,ERRMSG ERROR MESSAGE M2840 08126002 MVC MSGTEXT(L'ERR9+L'ERR9C),ERR9 M2840 08128002 B ERRPTR GO PRINT MESSAGE M2840 08130002 TURNOFF NI SWITCHAL,MODEOFF TURN OFF ASCII MODE SET S20038 08132002 SPACE 3 08134002 UCBLOOP CR UCBSEQ,REG6 IS THIS THE LAST UCB PTR M2840 08136002 BC 4,CONT BRANCH ON NO M2840 08138002 SR UCBSEQ,UCBSEQ REINITIALIZE TO FIRST UCB M2840 08140002 LA REG5,UCBAREA REINITIALIZE A23445 08150018 CONT LR REG8,UCBSEQ HAS THIS UCB BEEN ZEROED M2840 08160002 SLL REG8,2 ZEROED OUT 08180000 AR REG8,REG5 10432 08200014 MVC TCB(LNG4),0(REG8) SAVE CURRENT UCB PTR M2840 08210002 CLC 0(LNG4,REG8),ZERO IS CURRENT POINTER ZERO M2840 08220002 BC 7,DUMMYBLD BRANCH IF NOT ZERO S20038 08230020 LA UCBSEQ,BUMP1(I0,UCBSEQ) POINT TO NEXT UCB M2840 08250002 LA REG4,BUMP1(REG4) HAVE ALL UCBS M2840 08260002 CR REG4,REG6 BEEN ZEROED OUT 08280000 BC 10,ALLBAD BRANCH IF ALL BAD 08300000 B UCBLOOP EXAMINE NEXT UCB M2840 08320002 EJECT 08320402 DUMMYBLD MVC DUMMYHDR(L'HEADER1),HEADER1 CREATE DUMMY HDR LBL S20038 08322020 MVC DUMMYHDR+5(75),DUMMYHDR+4 PROPAGATE EBCDIC ZEROES S20038 08324020 MVC HERE(L'HERE),LABEL HOLD VOL ID AND SERIAL NO.S20038 08326020 TM SWITCHAL,ASCIISW IS ASCII LABEL SPECIFIED S20038 08328020 BNO FILL BRANCH IF NO S20038 08330020 MVI DUMMYHDR+53,BLANKCOL BLANK IN ACCESS. BYTE A38606 08331020 LA REG0,L'LABEL+L'DUMMYHDR NO.OF BYTES TO BE XLATED S20038 08332020 XLATE LABEL,(0),TO=A TRANSLATE LABEL TO ASCII S20038 08334020 FILL STC UCBSEQ,SVCLST+3 INSERT UCB SEQUENCE NUMBER M2840 08340002 LA REG1,DDNAM GET ADDR OF DDNAME M2840 08360002 ST REG1,SVCLST+4 MAKE IT 2ND WORD, SVCLIST 08380002 LA REG1,HERE PASS ADDR OF EBCDIC S20038 08386020 ST REG1,SVCLST+16 VOL ID AND SERIAL NO. S20038 08392020 LA REG1,SVCLST 08400000 OC D12(LNG4,REG1),L80 SET LENGTH EQUAL TO 80 BYTES AND 08420002 * NUMBER OF LABELS TO ONE 08440000 LA REG1,LABEL PUT ADDRESS OF TAPE LABEL INTO 08460000 ST REG1,SVCLST+8 PARAMETER LIST FOR SVC 08480000 L REG4,ZERO GOOD UCB SO INITIALIZE COUNTER 08520000 * TO ZERO AND START COUNTING 08540000 * BAD UCB'S AGAIN 08560000 LABEL MF=(E,SVCLST) TAPE LABEL MACRO S20038 08570020 TM SWITCHAL,ASCIISW WAS ASCII LAB SPECIFIED S20038 08585020 BNO OUTCOME BRANCH ON NO S20038 08590020 ST REG15,HERE SAVE SVC 39 RETURN CODE S20038 08595020 LA REG0,L'LABEL NO.OF BYTES TO BE XLATED S20038 08600020 XLATE LABEL,(0),TO=E RESTORE EBCDIC FOR PRINTG S20038 08605020 L REG15,HERE RESTORE SVC 39 RET. CODE S20038 08610020 OUTCOME C REG15,EIGHT UNACCEPTABLE PARM LIST S20038 08615020 BC 7,OPRATOR SYSTEM ERROR 08620000 BAL REG14,ERRMSG ERROR MESSAGE S20038 08790020 MVC MSGTEXT(L'ERR5),ERR5 MOVE IN ERROR MESSAGE M2840 08800002 L REG3,TCB GET DEVICE NAME FROM UCB M2840 08820002 USING UCB,REG3 M2840 08840002 MVC MSGWTR+L'ERR5(L'UCBNAME),UCBNAME M2840 08860002 DROP REG3 M2840 08880002 B PERIO2 GO PRINT ERROR MESSAGE M2840 08980002 ALLBAD MVI RC,RCODE08 SET RETURN CODE TO 8 M2840 09000002 BAL REG14,ERRMSG ERROR MESSAGE S20038 09130020 MVC MSGTEXT(L'ERR7),ERR7 UNUSEABLE M2840 09140002 LINK EP=IEHPRNT 09220000 B EOF SEE IF ANOTHER LABEL SET M2840 09240002 OPRATOR C REG15,FOUR OPERATOR COULD NOT MOUNT TAPE 09260000 BC 7,PERIO RETURN CODE NOT 4, BRANCH M2840 09280002 MVI RC,RCODE08 SET RETURN CODE TO 8 M2840 09300002 BAL REG14,ERRMSG ERROR MESSAGE S20038 09430020 MVC MSGTEXT(L'ERR4),ERR4 OPERATOR SUPPRESSED VOL M2840 09440002 MVC MSGTEXT+L'ERR4(L'SERIAL),SERIAL LABEL @ZA04374 09460003 LINK EP=IEHPRNT 09540000 C REG15,ZERO ERROR IN IEHPRNT M2840 09560002 BC 7,RETURN YES, GO END JOB M2840 09580002 B PAST1 NO, SET UP FOR NEXT LABEL M2840 09600002 GOOD BAL REG14,ERRMSG MESSAGE AREA SET UP M2840 09660002 MVC MSGTEXT(L'LABEL),LABEL PRINT LABEL JUST WRITTEN M2840 09700002 LINK EP=IEHPRNT 09780000 PAST1 LA UCBSEQ,BUMP1(I0,UCBSEQ) INCREMENT UCB COUNTER. M2840 09800002 SR STWREG,STWREG CLEAR WORK REG M2840 09810002 IC STWREG,NUMTPS TAPES LEFT TO LABEL M2840 09812002 BCT STWREG,AGAIN IF MORE TAPES TO LABEL FOR M2840 09820002 * THIS CONTROL CARD, THEN M2840 09840002 * BRANCH AND SAVE NUMTPS. M2840 09850002 B EOF IF NOT, GO TO EOF. M2840 09860002 PERIO C REG15,C IS THIS A PERM IO ERROR M2840 10200002 BC 6,GOOD BRANCH IF NO M2840 10220002 BAL REG14,ERRMSG ERROR MESSAGE S20038 10390020 MVC MSGTEXT(L'ERR6),ERR6 PERM I/O ERROR MSG TEXT M2840 10400002 L REG3,TCB GET DEVICE NAME FROM UCB M2840 10420002 USING UCB,REG3 M2840 10440002 MVC MSGTEXT+L'ERR6(L'UCBNAME),UCBNAME M2840 10460002 DROP REG3 M2840 10480002 PERIO2 MVC 0(LNG4,REG8),ZERO ZERO OUT UCB M2840 10530002 MVI RC,RCODE08 SET UP RETURN CODE OF 8 M2840 10540002 LINK EP=IEHPRNT GO PRINT ERROR MESSAGE M2840 10560002 C REG15,ZERO ERROR IN IEHPRNT M2840 10580002 BC 7,RETURN YES, GO END JOB M2840 10600002 B UCBLOOP NO, SET UP FOR NEXT LABEL M2840 10620002 AGAIN STC STWREG,NUMTPS SAVE TAPES LEFT TO LABEL M2840 10630002 MVC PARMKEEP(6),SERIAL SERIAL NUMBER ALL NUMERIC M2840 10640002 NC PARMKEEP+ONE1(LNG5),PARMKEEP M2840 10660002 TM PARMKEEP+5,FOXZERO TEST FOR NUMERICS M2840 10680002 BNO EOF BRANCH IF NOT NUMERICS S20038 10700020 XC HERE(LNG8),HERE CLEAR PART OF WORK AREA M2840 10740002 PACK HERE+4(4),SERIAL INCREMENT THE SERIAL M2840 10760002 CVB STWREG,HERE NUMBER BY ONE M2840 10780002 LA STWREG,BUMP1(STWREG) M2840 10800002 CVD STWREG,HERE SAVE INCREMENTED NUMBER M2840 10820002 UNPK SERIAL,HERE+4(4) RESTORE UPDATED SERIAL M2840 10840002 OI SERIAL+5,FOXZERO CLEAR SIGN BITS M2840 10860002 B UCBLOOP SET UP FOR NEXT TAPE M2840 10960002 SPACE 3 10960102 ERRMSG MVI MSGTEXT,BLANKCOL CLEAR AREA FOR MESSAGE M2840 10960402 MVC MSGTEXT+1(119),MSGTEXT TO BLANKS M2840 10960802 L REG9,CS2 BASE FOR SECOND CSECT M2840 10961202 LA REG13,SAVE IEHINITT SAVE AREA M2840 10962402 LA REG12,COMTAB PORTION OF COMMON AREA M2840 10962802 BR REG14 RETURN S20038 10963020 SPACE 3 10965002 MESSAGE BAL REG14,ERRMSG SET UP FOR ERROR MSG S20038 10968002 MVC MSGTEXT(L'ERRA+L'ERRAC),ERRA INVALID PARM M2840 10969002 B CONTBAD BRANCH TO PRINT RTN S20038 10971020 BAD BAL REG14,ERRMSG SET UP FOR ERROR MSG S20038 11050002 MVC MSGTEXT(L'ERR8),ERR8 TERMINATION M2840 11060002 CONTBAD LINK EP=IEHPRNT M2840 11140002 TERMIN MVI RC,RCODE16 SET RETURN CODE OF 16 M2840 11160002 B GOAHEAD GO CLOSE AND FREEMAIN M2840 11200002 EOF TM SWITCHRD,BIT2 CHECK TO SEE IF THIS WAS THE 11400000 BC 8,REDO LAST GROUP OF LABELS 11420000 RETURN TM POPENFLG,BADOPEN PRINT DCB OPENED M2840 11440002 BO GOAHEAD BR IF SYSPRINT IS OPEN 9837 11460014 * M2840 11470002 * INCREMENT RETURN CODE BY FOUR WHEN SYSPRINT M2840 11472002 * CARD IS OMITTED M2840 11474002 * M2840 11476002 SR STWREG,STWREG CLEAR WORK REGISTER M2840 11480002 IC STWREG,RC GET SAVED RETURN CODE M2840 11500002 LA STWREG,DSP4(STWREG) ADD 4 TO SAVED RC M2840 11520002 STC STWREG,RC RETURN CODE TO SAVE AREA M2840 11540002 GOAHEAD L REG13,SAVE+4 RESTORE CALLER'S REG 13 M2840 11560002 CLOSE MF=(E,READAD) 11580000 CLOSE MF=(E,PRINTAD) 11600000 * M2840 11610002 * IF IEHINITT INVOKED, SEE IF UPDATED PAGE M2840 11612002 * TO BE RETURNED TO CALLING PROGRAM M2840 11614002 * M2840 11616002 L REG1,24(REG13) GET CALLER'S PARM REG M2840 11620002 TM 0(REG1),ENDLIST OPT. HIGH ORDER BIT ON? M2840 11630002 BO SKPSTR PAGE NOT PASSED, BRANCH M2840 11640002 TM DSP4(REG1),ENDLIST DDNAME HIGH ORDER BIT ON? M2840 11650002 BO SKPSTR PAGE NOT PASSED, BRANCH M2840 11660002 L REG1,DSP8(REG1) GET ADDR OF PAGE IN LIST M2840 11680002 LH REG2,PAGENUM PICK UP NEXT PAGE NUMBER M2840 11683002 CVD REG2,HERE 11686020 UNPK TWO(LNG4,REG1),HERE+5(LNG3) UNPACK PAGE BACK TO S20038 11689020 * PARAMETER LIST S20038 11692020 OI DSP5(REG1),FOXZERO SET LOW ORDER ZONE M2840 11695002 SKPSTR SR REG6,REG6 PRESERVE RETURN CODE 000C 11800000 IC REG6,RC 11820000 LA REG1,LABEL 11840000 FREEMAIN R,LV=0+LAST-FIRST,A=(1) 11860000 SR REG15,REG15 11880000 LR REG15,REG6 SET RETURN CODE IN RETURN CODE REG. 9527 11900013 BACK RETURN (14,12),T,RC=(15) 10626 11920014 EJECT 11920402 OUTEXIT LH REG5,PRINT+62 LOAD SYSPRINT BLKSIZE M2840 11920702 LTR REG5,REG5 BLZSIZE BINARY ZEROS M2840 11921402 BC 8,DCBSIZ BRANCH IF NONE SPECIFIED BS0H 11922117 LA REG6,ABS121 TEST FOR MODULAR BLKSIZE BS0H 11922802 SR REG4,REG4 CLEAR REMAINDER REG M2840 11923502 DR REG4,REG6 11924202 LTR REG4,REG4 11924902 BCR 8,REG14 RETURN IF MODULAR BLKSIZE BS0H 11925617 MVI DFLG,BIT3 SYSPRINT BLKSIZE ERROR M2840 11926302 DCBSIZ MVC PBLKSZ,PLRECL LRECL (121) TO BLKSIZE M2840 11927002 RETURN 11927717 SPACE 3 11929702 INEXIT LH REG5,READ+62 LOAD SYSIN BLKSIZE BS0H 11929817 LTR REG5,REG5 BS0H 11930517 BC 8,DCBFIX BRANCH IF NONE SPECIFIED BS0H 11931217 LA REG6,80 TEST FOR MODULAR BLKSIZE BS0H 11931917 SR REG4,REG4 BS0H 11932617 DR REG4,REG6 BS0H 11933317 LTR REG4,REG4 BS0H 11934017 BCR 8,REG14 RETURN IF MODULAR BLKSIZE BS0H 11934717 MVI DFLAG,X'10' SET SYSIN BLKSIZE ERROR FLAG BS0H 11935417 MVC READ+62(2),READ+82 MOVE LRECL TO BLKSIZE BS0H 11936117 RETURN 11936817 DCBFIX MVI READ+63,X'50' INSERT BLKSIZE -- 80 BS0H 11937517 RETURN 11938517 SPACE 3 11938602 * 11938702 * THE FOLLOWING MOVE INSTRUCTIONS ARE EXECUTED 11938802 * 11938902 MVZO MVC 1(0,REG1),0(REG1) ZERO OUT WORK AREA 11939002 MVEUCB MVC UCBAREA(0),0(REG5) MOVE IN UCB PTRS A23445 11939102 TAPENUM MVC 0(0,STWREG),0(REG1) MOVE IN NUMBER OF TAPES M2840 11942202 ONAMHOLD MVC OWNRHOLD(0),0(REG1) MOVE OWNER TO HOLD AREA S20038 11944202 ONAMEBCD MVC LABEL+41(0),OWNRHOLD MOVE OWNER TO EBCDIC LAB S20038 11944602 ONAMASCI MVC LABEL+37(0),OWNRHOLD MOVE OWNER TO ASCII LABEL S20038 11945002 MOVSER MVC SERIAL(0),0(REG1) MOVE IN SERIAL NUMBER M2840 11945402 DDMVE MVC DDNAM(0),CARD 11945802 SPACE 3 11945902 * S20038 11946002 * REGISTER ALLOCATION, MASK AND BIT SETTINGS S20038 11949502 * S20038 11953002 REG0 EQU 0 11956502 REG1 EQU 1 11960000 REG2 EQU 2 11980000 REG3 EQU 3 12000000 REG4 EQU 4 12020000 REG5 EQU 5 12040000 REG6 EQU 6 12060000 REG7 EQU 7 12080000 REG8 EQU 8 12100000 UCBSEQ EQU 7 REGISTER FOR UCB SEQ NO M2840 12110002 REG9 EQU 9 12120000 MSGBASE EQU 9 REMOVE AND MODIFY REG 9 12130002 REG10 EQU 10 12140000 GOTTEN EQU 10 REG TO ADDR GETMAIN AREA M2840 12150002 REG11 EQU 11 12160000 INITBASE EQU 11 BASE FOR IEHINITT ROOT MOD M2840 12170002 REG12 EQU 12 12180000 STWREG EQU 12 SHORT TIME WORK REGISTER M2840 12190002 REG13 EQU 13 12200000 REG14 EQU 14 12220000 REG15 EQU 15 12240000 BIT0 EQU X'80' MASK TO SET AND TEST BIT 0 M2840 12260002 BIT1 EQU X'40' MASK TO SET AND TEST BIT 1 M2840 12280002 BIT2 EQU X'20' MASK TO SET AND TEST BIT 2 M2840 12300002 BIT3 EQU X'10' MASK TO SET AND TEST BIT 3 M2840 12320002 BIT4 EQU X'08' MASK TO SET AND TEST BIT 4 M2840 12340002 BIT5 EQU X'04' MASK TO SET AND TEST BIT 5 M2840 12360002 BIT6 EQU X'02' MASK TO SET AND TEST BIT 6 M2840 12380002 BIT7 EQU X'01' MASK TO SET AND TEST BIT 7 M2840 12400002 NO EQU 8 BRANCH CONDITION M2840 12420002 YES EQU 1 BRANCH CONDITION M2840 12460002 ASCIISW EQU X'80' ASCII LAB.PARM SPECIFIED S20038 12482020 OWNRSW EQU X'40' OWNER PARM WAS SPECIFIED S20038 12484020 ASCIMODE EQU X'10' 9 TRK TAPE MODE SETTING S20038 12486020 OWNEROFF EQU X'BF' TO SET OFF THE OWNER FLAG S20038 12488020 MODEOFF EQU X'EF' TO SET OFF ASCII MODE SET S20038 12490020 SECURE EQU X'F0' EBCDIC SECURITY DEFAULT S20038 12492020 ASCIISTD EQU X'F1' ASCII LABEL STDS MET S20038 12494020 NULL EQU X'00' TO CLEAR A 1-BYTE SWITCH S20038 12496020 ELEVEN EQU 11 12498020 ONE1 EQU 1 USED AS LENGTH & DISP S20038 12500020 TWO EQU 2 LENGTH & DISPLACEMENT S20038 12502020 DSP1 EQU 1 DISPLACEMENT VALUE M2840 12502102 DSP4 EQU 4 DISPLACEMENT VALUE M2840 12502202 DSP5 EQU 5 DISPLACEMENT VALUE M2840 12502302 DSP6 EQU 6 DISPLACEMENT VALUE M2840 12502902 DSP8 EQU 8 DISPLACEMENT VALUE OF 8 M2840 12504802 DSP9 EQU 9 DISPLACEMENT VALUE M2840 12505402 D12 EQU 12 DISPLACEMENT VALUE M2840 12506002 D24 EQU 24 DISPLACEMENT VALUE M2840 12506602 D34 EQU 34 DISPLACEMENT VALUE M2840 12507202 D42 EQU 42 DISPLACEMENT VALUE M2840 12507802 DSP79 EQU 79 DISPLACEMENT VALUE M2840 12508202 LNG0 EQU 0 LENGTH ATTRIBUTE S20038 12508402 LNG3 EQU 3 LENGTH ATTRIBUTE S20038 12509002 LNG4 EQU 4 LENGTH ATTRIBUTE S20038 12509602 LNG5 EQU 5 LENGTH ATTRIBUTE M2840 12510002 LNG7 EQU 7 LENGTH ATTRIBUTE M2840 12510202 LNG8 EQU 8 LENGTH ATTRIBUTE M2840 12510802 L24 EQU 24 LENGTH ATTRIBUTE M2840 12511402 L79 EQU 79 LENGTH ATTRIBUTE M2840 12511802 L119 EQU 119 LENGTH ATTRIBUTE M2840 12511902 NINE EQU 9 DISPLACEMENT S20038 12512002 ABS1 EQU 1 ABSOLUTE VALUE OF 1 M2840 12512702 ABS16 EQU 16 ABSOLUTE 16 (CVT PTR) M2840 12514702 ABS60 EQU 60 ABSOLUTE VALUE OF 60 M2840 12515102 ABS121 EQU 121 ABSOLUTE VALUE OF 121 M2840 12515502 ABS255 EQU 255 ABSOLUTE VALUE OF 255 M2840 12515702 ABS256 EQU 256 ABSOLUTE VALUE OF 256 @ZA01679 12516102 BUMP1 EQU 1 INCREMENT REG WITH LD ADDR M2840 12517702 I0 EQU 0 INDEX REG VALUE OF ZERO M2840 12517802 BADOPEN EQU X'10' DCB OPEN NOT SUCCESSFUL M2840 12518102 RCODE08 EQU X'08' RETURN CODE OF EIGHT M2840 12518402 RCODE16 EQU 16 RETURN CODE OF SIXTEEN M2840 12521102 BLANKCOL EQU X'40' CHARACTER OF 'BLANK' M2840 12523802 BINZERO EQU X'00' BINARY ZERO CLEAR CHAR M2840 12526502 OPENOUT EQU X'8F' END OF LIST, OUTPUT FILE M2840 12529202 ENDLIST EQU X'80' END OF PARAMETER LIST M2840 12531902 ENDJFCB EQU X'87' END OF LIST, JFCB M2840 12532302 FOXZERO EQU X'F0' MASK TO TEST NUMERICS M2840 12533902 * 12534602 * SET UP THE DCB'S TO READ IN THE CARD FROM THE CARD 12537302 * READER AND PRINT THEM OUT AGAIN 12540000 * 12560000 * PRINT DATA CONTROL BLOCK MACRO S20038 12566020 * S20038 12572020 PRINT1 DCB DSORG=PS,MACRF=(PM),RECFM=FBA,LRECL=121, BS0H*12580017 EXLST=OPT1,BUFNO=1 BS0H 12600017 * S20038 12605020 * READ DATA CONTROL BLOCK MACRO S20038 12610020 * S20038 12615020 READ1 DCB DSORG=PS,MACRF=(GM),RECFM=FB,LRECL=80, BS0H*12620017 EXLST=OPT2,BUFNO=1 17128 12640017 * 12660000 * CONSTANTS S20038 12660820 * ERROR MESSAGES, CONTROL CARD INFORMATION, TABLE FOR SERIAL NO. S20038 12661620 * MAKE-UP, AND MISCELLANEOUS CONSTANTS S20038 12662420 * S20038 12663220 OPT1 DC X'85' BS0H 12664017 DC AL3(OUTEXIT) BS0H 12668017 OPT2 DC X'85' BS0H 12672017 DC AL3(INEXIT) BS0H 12676017 TWO55 DC F'255' USED TO CLEAR GETMAIN AREA M2840 12680002 TWO56 DC F'256' USED TO CLEAR GETMAIN AREA M2840 12690002 L80 DC X'00500100' 12700000 LABTYPE DC CL8'LABTYPE=' INITT STATEMENT KEYWORD 12706002 AL DC CL2'AL' ASCII PARAMETER S20038 12712020 SER DC CL4'SER=' INITT STATEMENT KEYWORD M2840 12720002 DISP DC CL5'DISP=' INITT STATEMENT KEYWORD M2840 12740002 OWNRN DC CL6'OWNER=' INITT STATEMENT KEYWORD M2840 12760002 NUMBTAPE DC CL9'NUMBTAPE=' INITT STATEMENT KEYWORD M2840 12800002 REWIND DC CL6'REWIND' INITT STATEMENT PARAMETER M2840 12840002 LINCT DC CL8'LINECNT=' EXEC STATEMENT PARAMETER M2840 12860002 INITT DC CL6'INITT ' COMMAND WORD CONSTANT M2840 12880002 CS2 DC A(IEHINIT2) ADDRESS OF MSG CSECT S20038 12892020 SIX10 DC F'16' 13260000 EIGHT DC F'8' 13280000 ZERO DC D'0' 13300000 TEN DC F'10' EBCDIC OWNER PARM LENGTH M2840 13340002 FOURTEEN DC F'14' ASCII OWNER PARM LENGTH S20038 13350020 FIVE DC H'40' DDNAMEADDR, SYSIN DISP M2840 13380002 SIX DC H'48' DDNAMEADDR, SYSPRINT DISP M2840 13400002 FOUR1 DC X'0004' PAGECNT LENGTH S20038 13405020 MAXCT DC H'10' MAX LNG OF LINECNT PARM S20038 13410020 SYSPRINT DC CL8'SYSPRINT' UTILITY OUTPUT DSN M2840 13420002 SYSIN DC CL8'SYSIN' CONTROL DATA SET DSN M2840 13440002 C DC F'12' TO CHECK RETURN CODE M2840 13460002 FOUR DC F'4' TO CHECK RETURN CODE M2840 13480002 FTHREE DC F'3' TO CHECK NUMBTAPE PARM LNG M2840 13490002 VLM DC CL4'VOL1' STANDARD VOLUME LABEL ID M2840 13500002 HEADER1 DC CL5'HDR10' STARDARD HDR1 ID M2840 13510002 RWND DC X'C00004' 13540000 UNLD DC X'C00006' 13560000 * S20038 13560120 * THE HYPHEN,PERIOD,ALPHAMERICS AND NATIONAL ARE ACCEPTABLE @ZA16491 13560299 * CHARACTERS IN THE MAKEUP OF THE SERIAL NUMBER. THE FOLLOWING @ZA16491 13563099 * TABLE IS IN ORDER BY THE BINARY SEQUENCE OF THE EBCDIC CODE. @ZA16491 13564299 * ZEROES INDICATE ACCEPTABLE CHARACTERS. HENCE, THE TABLE @ZA16491 13565499 * COULD BE MODIFIED BY MAINTAINING THIS PRACTICE. @ZA16491 13566699 TABLE DC 75X'01' NOT ACCEPTABLE @ZA16491 13567899 DC X'00' '.' ACCEPTABLE @ZA16491 13568499 DC 15X'01' NOT ACCEPTABLE @ZA16491 13568899 DC X'00' '$' ACCEPTABLE @ZA16491 13568999 DC 4X'01' NOT ACCEPTABLE @ZA16491 13569299 DC X'00' '-' ACCEPTABLE @ZA16491 13570099 DC 26X'01' NOT ACCEPTABLE @ZA16491 13570199 DC X'00' '#' ACCEPTABLE @ZA16491 13570499 DC X'00' '@' ACCEPTABLE @ZA16491 13570899 DC 68X'01' NOT ACCEPTABLE @ZA16491 13571099 DC 9X'00' ALPHABETIC CHARACTER M2840 13571402 DC 7X'01' NOT ACCEPTABLE M2840 13572602 DC 9X'00' ALPHABETIC CHARACTER M2840 13573802 DC 8X'01' NOT ACCEPTABLE M2840 13575002 DC 8X'00' ALPHABETIC CHARACTER M2840 13576202 DC 6X'01' NOT ACCEPTABLE M2840 13577402 DC 10X'00' NUMERIC CHARACTER M2840 13578602 DC 6X'01' NOT ACCEPTABLE M2840 13579802 * 13581002 * 13591002 ORG *+200 MAINTENANCE AREA M2840 13601002 * 13611002 * 13613002 IEHINIT2 CSECT 13621002 * THIS CSECT CONTAINS ALL THE MESSAGES THAT THE IEHINITT S20038 13623002 * MODULE SENDS TO THE PRINT MODULE S20038 13625002 * S20038 13627002 ERR1 DC CL33'IEH601I INVALID CONTROL STATEMENT' S20038 13629002 ERR2 DC CL23'IEH602I INVALID KEYWORD' M6029 13629402 ERR3 DC CL31'IEH603I INVALID PARAMETER VALUE' S20038 13629802 ERR4 DC CL41'IEH604I OPERATOR SUPPRESSED VOLUME LABEL ' 13629902 ERR5 DC CL37'IEH605I INVALID DEVICE ALLOCATED ON ' 13633902 ERR6 DC CL32'IEH606I PERMANENT I/O ERROR ON ' 13636002 ERR7 DC CL35'IEH607I ALLOCATED DEVICES EXHAUSTED' S20038 13638002 ERR8 DC CL43'IEH608I I/O ERROR ON SYSIN. JOB TERMINATED.' S20038 13638402 ERR9 DC CL43'IEH609I INVALID DEVICE SPECIFIED FOR ASCII ' S20038 13638802 ERR9C DC CL8'LABELING' S20038 13638902 ERRA DC CL41'IEH610I INVALID PARM OR PARM LIST PASSED ' S20038 13639202 ERRAC DC CL14'TO IEHINITT.' M2840 13639602 ERRB DC CL43'IEH611I INVALID DENSITY SPECIFIED, DEFAULT ' S20038 13639702 ERRBC DC CL10'VALUE USED' M2840 13639802 X DS 0F 13647202 * S20038 13651302 * S20038 13659502 * JOB FILE CONTROL BLOCK - SYMBOLIC NAMES S20038 13663602 * - USED TO OBTAIN DENSITY SETTING S20038 13667702 * S20038 13671802 JFCB DSECT 13675902 IEFJFCBN 13680000 * S20038 13684020 * UNIT CONTROL BLOCK - SYMBOLIC NAMES S20038 13688020 * - USED TO DETERMINE TAPE MODE SETTING S20038 13692020 * S20038 13696020 UCB DSECT 13700000 IEFUCBOB 13720000 * S20038 13722020 * WORKING STORAGE - S20038 13724020 * THIS CONTROL MODULE OBTAINS CORE STROAGE FOR A COMMON WORKING S20038 13726020 * AREA SHARED BY IEHINITT, IEHSCAN, IEHPRNT FOR THE PURPOSE OF S20038 13728020 * PASSING SWITCH SETTINGS, READ AND PRINT DCB'S, MESSAGES, AND S20038 13730020 * PARAMETERS, AS WELL AS HOLDING THE CONTROL CARD AND TAPE LABEL S20038 13732020 * IMAGES, AND SAVE AREAS. S20038 13734020 * S20038 13736020 WORK DSECT 0F 13740000 FIRST DS 0F 13760000 * 13760402 * THE FOLLOWING AREA DESCRIBES THE VOLUME M2840 13762002 * LABEL (80 BYTES) AND DUMMY HDR1 M2840 13764002 * RECORD (80 BYTES). THESE AREAS M2840 13766002 * MUST BE CONTIGUOUS M2840 13768002 * 13768402 LABEL DS 0CL80 MUST BE S20038 13770002 VOL1 DS CL4 CONSTANT VOL1 FIELD M2840 13772002 SERIAL DS CL6 VOLUME SERIAL FIELD M2840 13774002 SECURITY DS CL1 VOLUME SECURITY FIELD M2840 13774402 DS CL69 NOT REFERENCED M2840 13776002 DUMMYHDR DS CL80 CONTIGUOUS S20038 13780020 * 13782002 * THE FOLLOWING AREA DESCRIBES THE LIST M2840 13784002 * PASSED TO THE LABEL SVC. THE AREA M2840 13786002 * MUST BE CONTIGUOUS AND MUST BE M2840 13788002 * ALIGNED ON A FULLWORD BOUNDARY M2840 13788402 * 13788802 SVCLST DS 0CL20 FIVE WORD PARM LIST M2840 13790002 SVCRUNOP DS CL3 REWIND/REWIND-UNLOAD M2840 13800002 SVCUCB DS CL1 UCB INDICATOR M2840 13810002 SVCDDPTR DS CL4 POINTER TO DDNAME M2840 13812002 SVCLBLPT DS CL4 PTR TO LABEL/DUMMY HEADER M2840 13814002 DS CL8 13816002 * 13818002 HOMEJFCB DS CL176 INPUT AREA FOR RDJFCB M2840 13820002 * 13870002 CARD DS CL80 SCANNED CARD INPUT AREA M2840 13900002 * 13950002 DISP12 DS F SAVE FOR START NEXT SCAN M2840 14000002 PARMPTR DS F PTR TO START PASSED PARM M2840 14020002 LNGPARM DS F LENGTH OF PASSED PARAM M2840 14040002 COMTAB DS 0F 14140000 READAD DS F ADDRESS OF READ DCB M2840 14160002 PRINTAD DS F ADDRESS OF PRINT DCB M2840 14180002 JFLSTAD DS F ADDR OF HOMEJFCB (READIN) M2840 14182002 AGO DS F ADDR DUMMY DCB FOR RDJFCB M2840 14184002 JFCBLST DS F 14186002 * M2840 14190002 * MESSAGE LINE, INCLUDING PAGE AND LINE COUNT M2840 14190402 * M2840 14192002 MSGWTR DS 0CL128 M2840 14200002 CC DS CL1 CARRIAGE CONTROL (ASA) M2840 14210002 MSGTEXT DS CL120 PRINT LINE M2840 14212002 MFILL1 DS CL1 NOT REFERENCED M2840 14214002 PAGENUM DS CL2 STARTING PAGE NUMBER M2840 14216002 LINETOT DS CL2 TOTAL LINES PER PAGE M2840 14218002 LINELEFT DS CL2 LINES NOT YET PRINTED M2840 14218402 * M2840 14218802 SAVE DS 18F IEHINITT SAVE AREA M2840 14220002 GPSAVE DS 18F IEHSCAN SAVE AREA M2840 14240002 SAVEX DS 18F IEHPRNT SAVE AREA M2840 14250002 SAVEY DS 2F 14250401 SAVEZ DS 1F 14252001 MYSAVE EQU SAVEY 3 FULLWORD SAVE AREA M2840 14254002 TCB DS 1F TCB/UCB PTR SAVE AREA M2840 14260002 * M2840 14430002 * PRINT DCB M2840 14430402 * M2840 14432002 PRINT DS 0CL96 M2840 14440002 PFILL1 DS CL40 NOT REFERENCED M2840 14450002 PDDNAME DS CL8 DDNAME BEFORE OPEN M2840 14452002 POPENFLG DS CL1 OPEN FLAG M2840 14454002 PFILL2 DS CL8 NOT REFERENCED M2840 14456002 PSYNAD DS CL3 PRINTER SYNAD ADDRESS M2840 14456402 PFILL3 DS CL2 NOT REFERENCED M2840 14456802 PBLKSZ DS CL2 BLOCKSIZE M2840 14457202 PFILL4 DS CL18 NOT REFERENCED M2840 14457602 PLRECL DS CL2 RECORD LENGTH M2840 14457702 PFILL5 DS CL12 NOT REFERENCED M2840 14457802 * M2840 14458002 * READ DCB M2840 14458102 * M2840 14458402 READ DS 0CL96 M2840 14460002 RFILL1 DS CL33 NOT REFERENCED M2840 14470002 REODAD DS CL3 END OF DATA ADDRESS M2840 14472002 RFILL2 DS CL4 NOT REFERENCED M2840 14474002 RDDNAME DS CL8 DDNAME BEFORE OPEN M2840 14476002 ROPENFLG DS CL1 OPEN FLAG M2840 14478002 RFILL3 DS CL8 NOT REFERENCED M2840 14478402 RSYNAD DS CL3 SYNAD ADDRESS M2840 14482702 RFILL4 DS CL36 NOT REFERENCED M2840 14487102 * 14491402 * THE AREAS HERE AND THERE ARE WORK AREAS USED M2840 14501402 * FOR PACKING, UNPACKING, CONVERTING TO M2840 14511402 * DECIMAL, CONVERTING TO BIANRY, FIELD M2840 14521402 * ADJUSTMENT, AND OTHER WORK PURPOSES. M2840 14531402 * 14533402 D DS 0D 14540000 HERE DS CL10 14560000 THERE DS CL12 10432 14590014 * 14592002 VALFLGS DS CL1 VALID FLAGS A46764 14592402 VALCOMP DS CL1 DENSITY WORK AREA A46764 14592802 * 14593202 * LABEL DCB 14594002 * NOTE: THE ONLY FIELDS THAT APPLY TO 14596002 * THE DCB ARE GO, DDNAME, AND DCBFLAGS 14596402 * THESE FIELDS MUST BE AT +36, +40, AND 14596502 * +48 RESPECTIVELY. 14596602 * 14596802 * THE REMAINDER OF THE FIELDS ARE WORK AREA 14596902 * 14646902 DISP5 DS CL1 IEHSCAN SWITCH BYTE M2840 14666902 DISP8 DS CL1 IEHSCAN SWITCH BYTE M2840 14676902 DISP10 DS CL1 IEHSCAN CURRENT DELIM M2840 14686902 DISP11 DS CL1 IEHSCAN PREVIOUS DELIM M2840 14688902 LBLDCB DS 0CL96 DUMMY DCB 14689302 SWITCHRD DS CL1 IEHSCAN PASSBACK INDICATOR M2840 14690902 PARMLNG DS CL1 PARTIAL PARM LENGTH HOLD M2840 14692902 SWITCHAL DS CL1 SWITCH FOR ASCII LABEL S20038 14694902 KEY DS CL1 14695002 OWNRLNG DS F HOLD FOR OWNER LENGTH S20038 14695302 OWNRHOLD DS CL14 HOLD FOR OWNER PARM S20038 14695702 DFLG DS X BS0H 14696902 DFLAG DS X BS0H 14746902 LASTDD DS CL8 SAVE PREVIOUS DDNAME. 15673 14796902 RC DS CL1 RETURN CODE SAVE AREA M2840 14806902 SWITCH2 DS CL1 14816902 NUMTPS DS CL1 14826902 UCBNUM DS CL1 14836902 GO DC F'0' SAVE AREA FOR EXLIST 14996902 DDNAM DS CL8 SAVE AREA FOR DDNAME M2840 15046902 DC F'0' SAVE AREA FOR DCBFLG,DCBMACR 15146902 PARMKEEP DS CL44 PARAMETER SAVE AREA M2840 15156902 * 15206902 UCBAREA DS CL176 UCB PTRS FROM DD CARD A23445 15246902 PARMERR DS X LINECNT & PAGECNT ERROR M2840 15256902 LAST DS 0H 15296902 END 16246902