MACRO 00030051 &SADMP AMDSADM2 &IPL2=,&TYPE2=,&CONADDR=,&CONTYPE=,&OUTPUT2=, X00060051 &ADDR2=,&MCHK= @ZA27964 00080051 LCLC &OUTPUT,&CONSOLE 00100051 AIF ('&TYPE2' EQ 'HI').OUTCK2 HI IS A VALID PARM 00120051 AIF ('&TYPE2' EQ 'LO').OUTCK1 LO IS A VALID PARM 00140051 MNOTE 12,'TYPE2=&TYPE2 INVALID; MACRO PROCESSING TERMINATED' 00160051 MEXIT 00180051 .OUTCK1 ANOP CROSS CHECK FOR VALID OPTIONS 00200051 AIF ('&OUTPUT2'(1,1) EQ 'P').OUTCK5 LO AND PTR VALID 00220051 AGO .OUTCK3 CHECK FOR LO AND TAPE 00240051 .OUTCK2 ANOP VALIDITY CHECK HI AND PTR 00260051 AIF ('&OUTPUT2'(1,1) NE 'P').OUTCK3 OKAY IF PTR NOT SPEC 00360051 MNOTE 12,'OUTPUT2=&OUTPUT2 FOR TYPE=&TYPE2 INVALID; MACRO PROCX00390051 ESSING TERMINATED' 00420051 MEXIT 00450051 .OUTCK3 ANOP CHECK IF TAPE OUTPUT 00480051 AIF ('&OUTPUT2'(1,1) EQ 'T').OUTCK5 TAPE OKAY, CONTINUE 00500051 .OUTCK4 ANOP INVALID OUTPUT PARM 00520051 MNOTE 12,'OUTPUT2=&OUTPUT2 INVALID; MACRO PROCESSING TERMINATEX00540051 D' 00560051 MEXIT 00580051 .OUTCK5 ANOP FINAL OUTPUT VALIDITY CK 00600051 AIF (K'&OUTPUT2 NE 4).OUTCK4 ADDR MUST BE AT LEAST 3 CHAR 00620051 &OUTPUT SETC '&OUTPUT2'(2,4) SET OUTPUT ADDR FOR CODE 00640051 AIF ('&TYPE2' EQ 'HI').CONTYP2 SKIP ADDR= FOR HI 00660051 AIF ('&ADDR2' EQ 'REAL').CONTYP2 . REAL IS VALID 00680051 AIF ('&ADDR2' EQ 'VIRTUAL').CONTYP2 VIRTUAL IS VALID 00700051 MNOTE 12,'ADDR2=&ADDR2 INVALID. MACRO PROCESSING TERMINATED' 00720051 MEXIT 00740051 .CONTYP2 ANOP CHECK CONSOLE PARAMETERS 00760051 AIF (K'&CONADDR EQ 3).CONTYP1 CONSOLE ADDR MUST BE 3 CHAR 00930051 MNOTE 12,'CONADDR=&CONADDR INVALID; MACRO PROCESSING TERMINATEX00960051 D' 00990051 MEXIT 01020051 .CONTYP1 ANOP VALIDITY CHECK CONSOLE TYPES 01050051 AIF ('&CONTYPE' EQ '1052').T1052 SET UP 1052 TYPE SWITCH 01080051 AIF ('&CONTYPE' EQ '2150').T1052 SET UP 1052 TYPE SWITCH 01110051 AIF ('&CONTYPE' EQ '3210').T1052 SET UP 1052 TYPE SWITCH 01140051 AIF ('&CONTYPE' EQ '3215').T1052 SET UP 1052 TYPE SWITCH 01170051 AIF ('&CONTYPE' EQ '3066').T3066 SET UP 3066 TYPE SWITCH 01200051 AIF ('&CONTYPE' EQ '3277').T3277 3277 TYPE SWITCH @ZA00418 01230051 AIF ('&CONTYPE' EQ '3158').T3277 3158 TYPE SWITCH @ZA00418 01260051 AIF ('&CONTYPE' EQ '3036').T3277 3036 TYPE? @G51AGSG 01270051 MNOTE 12,'CONTYPE=&CONTYPE INVALID; MACRO PROCESSING TERMINATEX01290051 D' 01320051 MEXIT 01350051 .T1052 ANOP 1052 TYPE CONSOLE;SET SWITCH 01380051 &CONSOLE SETC 'A' 1052 TYPE 01400051 AGO .IPL1 CHECK IPL PARM 01420051 .T3066 ANOP 3066 TYPE CODE INIT 01440051 &CONSOLE SETC 'B' 3066 TYPE 01460051 AGO .IPL1 @ZA00418 01480051 .T3277 ANOP @ZA00418 01500051 &CONSOLE SETC 'C' 3277/3158 TYPE @ZA00418 01520051 .IPL1 ANOP CHECK IPL PARMS 01540051 AIF ('&IPL2'(1,1) EQ 'D').PROLOG1 IF DA OKAY-GEN DA IPL TXT 01650051 AIF ('&IPL2'(1,1) EQ 'T').TAPECK IF TAPE OK;GEN TAPE IPL 01680051 MNOTE 12,'IPL2=&IPL2 INVALID; MACRO PROCESSING TERMINATED' 01710051 MEXIT 01740051 .TAPECK ANOP VALIDITY CHECK TAPE & LO 01770051 AIF ('&TYPE2' NE 'LO').PROLOG1 TAPE-LO INCOMPATIBLE 01800051 MNOTE 12,'IPL2=&IPL2 AND TYPE2=&TYPE2 INCOMPATIBLE; MACRO PROCX01830051 ESSING TERMINATED' 01860051 MEXIT 01890051 .PROLOG1 ANOP PROLOGUE DEFINATION 01920051 TITLE 'AMDSADMP REAL DUMP MODULE' 01950051 ********************************************************************** 01980051 * * 02010051 * MODULE NAME : AMDSADM2 * 02040051 * * 02070051 * DESCRIPTIVE NAME : STAND ALONE DUMP, MACRO 2 * 02100051 * * 02130051 * LOAD MADULE : N/A * 02160051 * * 02190051 * COPYRIGHT : NONE * 02220051 * * 02250051 * STATUS: OS/VS2 RELEASE 3.8 (EBB1102) * 02280000 * * 02310051 * FUNCTION : * 02340051 * CSECT AMDSADM2: THIS MACRO GENERATES THE APPROPRIATE CODE * 02370051 * FOR THE TYPE OF DUMP REQUESTED BY THE MACRO PARAMETERS * 02400051 * CSECT AMDSAIP1: THIS MODULE CONTAINS THE IPL 1 RECORDS * 02430051 * WHICH READ IN THE IPL 2 RECORDS * 02460051 * CSECT AMDSAIP2: THIS ROUTINE CONTAINS THE IPL 2 RECORDS * 02490051 AIF ('&IPL2'(1,1) EQ 'D').PRO2 02520051 * WHICH READ IN THE AMDSAHSR ROUTINE * 02550051 AGO .PRO3 02580051 .PRO2 ANOP 02610051 * WHICH READ IN THE AMDSAPRO ROUTINE * 02640051 AIF ('&TYPE2' EQ 'LO').PRO4 02670051 .PRO3 ANOP 02700051 * CSECT AMDSAHSR: THIS IS THE HIGH SPEED REAL DUMP ROUTINE * 02730051 * WHICH FORMATS AND DUMPS REAL STORAGE TO AN OUTPUT TAPE * 02760051 * DEVICE AT TAPE SPEED * 02790051 AGO .PRO11 02820051 .PRO4 ANOP 02850051 * CSECT AMDSALSR: THIS IS THE LO SPEED DUMP ROUTINE WHICH * 02880051 * FORMATS AND DUMPS STORAGE TO EITHER A TAPE OR PRINTER * 02910051 * OUTPUT DEVICE * 02930051 .PRO11 ANOP 02950051 * * 02970051 * OPERATION : THE AMDSADM2 MODULE IS THE REAL STORAGE DUMPING ROUTINE 02990051 * FOR VS/2 DUMPS. THIS MODULE IS DIVIDED INTO THREE CSECTS * 03060051 * * 03090051 * (1) CSECT AMDSAIP1: THIS IS THE IPL1 RECORD FOR THE DUMP * 03120051 * PROGRAM. THIS RECORD CONSISTS OF A PSW FOLLOWED BY TWO * 03150051 * CCW'S. THE CCW'S READ INTO LOCATION X'110' AMDSAIP2 * 03180051 * * 03210051 * (2) CSECT AMDSAIP2: THIS IS THE IPL 2 RECORD FOR THE * 03240051 AIF ('&IPL2'(1,1) EQ 'D').PRO23 03270051 * PROGRAM. THIS RECORD WILL READ THE REAL DUMP PROGRAM * 03300051 * INTO LOCATION X'7000', AFTER WRITING OUT A FIXED LENGTH * 03330051 * OF STORAGE STARTING AT LOCATION X'7000' TO THE IPL DEVICE. 03360051 AGO .PRO21 03390051 .PRO23 ANOP 03420051 * PROGRAM. THIS RECORD WILL READ THE PRECURSOR PROGRAM * 03450051 * INTO LOCATION X'7800', AFTER WRITING OUT A FIXED LENGTH * 03480051 * OF STORAGE STARTING AT LOCATION X'7800' TO THE IPL DEVICE. 03510051 * THE LENGTH OF THIS RECORD IS X'800' BYTES * 03540051 * THE PRECURSOR ROUTINE WILL LOAD THE HI OR LO SPEED DUMP * 03570051 * ROUTINE AND TRANSFER CONTROL TO IT AT LOCATION X'7020' * 03600051 * AFTER WRITING OUT A X'800' BYTE RECORD TO THE IPL * 03630051 * DEVICE FROM LOCATION X'7000'. THE CODE WHICH WRITES * 03660051 * OUT THIS RECORD IS CHAINED FROM AND TICED TO BY THE CCW * 03690051 * CHAIN IN AMDSAIP2. IT IS LOCATED AT THE BEGINNING OF * 03720051 * AMDSAPRO AT LOCATION X'7800' FOR A LENGTH OF 48 BYTES * 03750051 AIF ('&TYPE2' EQ 'LO').PRO12 03780051 AGO .PRO24 03810051 .PRO21 ANOP 03840051 * THE LENGTH OF THIS RECORD IS X'6006' BYTES * 03870051 .PRO24 ANOP 03900051 * (3) CSECT AMDSAHSR: THIS IS THE HIGH SPEED VERSION OF THE * 03930051 * AMDSADMP ROUTINE. ITS FUNCTION IS TO DUMP REAL STORAGE TO 03960051 * A TAPE OUTPUT DEVICE AT TAPE SPEED. THE ROUTINE RE- * 03980051 * QUESTS FROM THE OPERATOR, AN OUTPUT DEVICE ADDRESS * 04000051 * AND A DUMP TITLE. IT THEN DUMPS A CPU STATUS RECORD * 04020051 * FOR EACH ACTIVE CPU, STORAGE IN 4096 BYTE BLOCKS (5012 * 04040051 * BYTE RECORDS) TO TAPE FOR LATER PROCESSING BY * 04060051 * AMDPRDMP, AND DUMPS LOCATION 0-X'1FFFF' TO THE IPL * 04080051 * (WORKFILE) DEVICE FOR LATER USE BY THE VIRTUAL DUMP * 04100051 * FUNCTION. AT THE CONCLUSION OF DUMPING REAL STORAGE, CON- 04120051 * TROL IS PASSED TO THE PRECURSOR PROGRAM (AMDSAPRO) * 04230051 * WHICH LOADS THE VIRTUAL DUMP ROUTINE STARTING AT LOC- * 04260051 * ATION X'8000'. HSR SAVES ITS OWN REGISTERS BEFORE * 04290051 * PASSING CONTROL TO AMDSAPRO. * 04320051 AGO .PRO15 04350051 .PRO12 ANOP 04380051 * (3) CSECT AMDSALSR: THIS IS THE LOW SPEED VERSION OF THE * 04410051 * AMDSADMP PROGRAM. ITS FUCCTION IS TO DUMP REAL STORAGE * 04440051 * ( IN EITHER TRANSLATED OR UNTRANSLATED MODE ) TO A * 04500051 AIF ('&OUTPUT2'(1,1) EQ 'P').PRO99 04530051 * TAPE OUTPUT DEVICE. THE ROUTINE REQUESTS FROM THE * 04560051 AGO .PRO98 04590051 .PRO99 ANOP 04620051 * PRINTER OUTPUT DEVICE. THE ROUTINE REQUESTS FROM THE * 04650051 .PRO98 ANOP 04680051 * OPERATOR, AN OUTPUTDEVCCE ADDRESS, A DUMP TITLE, AND * 04710051 * EITHER A VIRTUAL OR REAL ADDRESS RANGE OF STORAGE TO BE * 04740051 * DUMPED. THE ROUTINE THEN DUMPS A CPU STATUS RECORD FOR * 04760051 * EACH ACTIVE CPU. IT THEN DUMPS AND FORMATS THE GPR'S * 04780051 * CR'S, F.P.REGS, CURRENT PSW AND REQUESTED STORAGE RANGE. * 04800051 AIF ('&OUTPUT2'(1,1) EQ 'P').PRO13 04820051 * STORAGE IS FORMATTED IN 32 BYTE BLOCKS AND DUMPED IN 120 * 04840051 AGO .PRO14 04860051 .PRO13 ANOP 04880051 * STORAGE IS FORMATTED IN 32 BYTE BLOCKS AND DUMPED IN 121 * 04900051 .PRO14 ANOP 05010051 * BYTE RECORES. WHEN COMPLETED, THE PROGRAM WRITES A * 05040051 * REAL DUMP DONE MESSAGE AND LOADS A WAIT STATE PSW. * 05070051 .PRO15 ANOP 05100051 * * 05130051 * NOTES: THE PROGRAM ISSUED THE FOLLOWING PRIVILEGED INSTRUCTIONS * 05160051 * SIO, TIO, STAP, SIGP (STOP AND STORE STATUS), AND LPSW * 05190051 * DEPENDENCIES: THIS PROGRAM IS DEPENDENT ON THE STANDARD CHARACTER* 05220051 * SET, CORRECTABLE BY RE-ASSEMBLY. * 05250051 * * 05280051 * RESTRICTIONS: NONE * 05310051 * * 05340051 * REGISTER CONVENTIONS: * 05370051 * R2 POINTS TO CURRENT STORAGE BLOCK * 05400051 * R3 POINTS TO ADDRESS OF MOST RECENT OUTPUT BLOCK * 05430051 AIF ('&TYPE2' EQ 'HI').PRO16 05460051 * R4 IS STORAGE KEY REGISTER OR OUTPUT LINE REGISTER * 05490051 .PRO16 ANOP 05520051 * R5 POINTS TO MESSAGE INPUT AREA: HIGH ORDER BYTE IS LENGTH * 05550051 * OF INPUT MESSAGE * 05580051 * R6 POINTS TO MESSAGE OUTPUT AREA: HIGH OREDR BYTE IS LENGTH* 05610051 * OF MESSAGE TO BE WRITTEN. * 05640051 * R9 POINTS TO MESSAGE IF ERROR OCCURS * 05670051 * R10 POINTS TO I/O DEVICE * 05700051 * R11 POINTS TO CCW TO BE EXECUTED * 05730051 * R12 BASE REGISTER CONTAINING REAL STORAGE ADDRESS X'7000' * 05760051 * R13 RETURN REGISTER FOR ENTRY TO DUMPSIO ROUTINE * 05790051 * R14 RETURN REGISTER FOR ENTRY TO CONSOLE ROUTINE * 05820051 * R15 RETURN CODE REGISTER * 05850051 * * 05880051 AIF ('&TYPE2' EQ 'HI').PRO17 05910051 * PATCH LABEL: LSRPATCH * 05940051 AGO .PRO18 05970051 .PRO17 ANOP 06000051 * PATCH LABEL: HSRPATCH * 06030051 .PRO18 ANOP 06060051 * * 06090051 * MODULE TYPE: MACRO * 06120051 * * 06150051 * MODULE SIZE: 4K MINUS THE LENGTH OF THE PORTION OF AMDSAPRO * 06180051 * WHICH CANNOT BE OVERLAYED WHEN THIS IS READ IN * 06187051 * ( X'F6' ) @ZA56338* 06194000 * * 06210051 * ATTRIBUTES: PRIVILEGED, DISABLED, STAND ALONE PROGRAM * 06240051 * * 06270051 * ENTRY POINTS: ENTRY TO IPL1 VIA LOAD FROM IPL * 06300051 * ENTRY TO IPL2 FROM IPL1 * 06330051 AIF ('&IPL2'(1,1) EQ 'T').PRO97 06360051 AIF ('&TYPE2' EQ 'LO').PRO95 06390051 * ENTRY TO HSR FROM PRECURSOR 06420051 AGO .PRO96 06450051 .PRO97 ANOP 06480051 * ENTRY TO HSR FROM IPL2 * 06510051 AGO .PRO96 06540051 .PRO95 ANOP 06570051 * ENTRY TO LSR FROM PRECURSOR * 06600051 .PRO96 ANOP 06630051 * * 06660051 * INPUT: STORE STATUS - THE OPERATOR SHOULD PERFORM THE * 06690051 * STORE STATUS FUNCTION PRIOR TO IPL. * 06720051 * THIS SAVES THE GPR'S, CR'S, AND F.P.REGS * 06750051 * PRIOR TO DUMPING. IF A STORE STATUS IS NOT * 06780051 * DONE, THE GPR CONTENTS WILL BE SAVED, HOW- * 06810051 * EVER, OTHER REGISTER CONTENTS MAY NOT BE * 06840051 * VALID. IN THE CASE, THE DUMP ROUTINE WILL * 06870051 * INDICATE THAT A STORE STATUS WAS NOT DONE. * 06900051 * * 06930051 * OUTPUT: A STAND ALONE DUMP * 06960051 * * 06990051 * EXITS NORMAL: AMDSAIP1 TO AMDSAIP2 * 07020051 AIF ('&IPL2'(1,1) EQ 'D').PRO94 07050051 * AMDSAIP2 TO AMDSAPRO * 07080051 AGO .PRO93 07110051 .PRO94 ANOP 07140051 * AMDSAIP2 TO AMDSAHSR * 07170051 .PRO93 ANOP 07200051 AIF ('&TYPE2' EQ 'LO').PRO92 07230051 * AMDSAHSR TO AMDSAPGE * 07260051 AIF ('&IPL2'(1,1) EQ 'T').PRO91 07290051 * AMDSAHSR TO AMDSAPRO * 07320051 AGO .PRO91 07350051 .PRO92 ANOP 07380051 * AMDSALSR TO A WAIT STATE PSW * 07410051 .PRO91 ANOP 07440051 * EXITS ERROR: WAIT STATE CODE X'04' * 07470051 * CATASTROPHIC I/O ERROR * 07500051 * CONSOLE NOT AVAILABLE FOR COMMUNICATIONS * 07530051 AIF ('&TYPE2' EQ 'LO').PRO90 07560051 * ERROR LOADING AMDSAPGE * 07590051 .PRO90 ANOP 07620051 * MNOTE - FOR INCORRECT PARAMETER AND TERMINATION * 07650051 * * 07680051 * EXTERNAL REFERENCES: NONE * 07710051 * * 07740051 * ROUTINES: CONSOLE-CONSOLE COMMUNICATIONS ROUTINE * 07770051 * CONVERT-EBCDIC TO BINARY ADDRESS CONVERSION * 07800051 * LABEL CHECK-DETERMINE WHETHER A TAPE IS LABELED * 07830051 * DUMPSIO- PERFORM ALL I/O OPERATIONS * 07860051 AIF ('&OUTPUT2'(1,1) EQ 'P').PRO89 07890051 * EOR-END OF REEL PROCESSING * 07920051 .PRO89 ANOP 07950051 * CATSEXIT-ERROR RECOVERY AND EXIT ROUTINE * 07980051 * * 08010051 * DATA SETS: NONE * 08040051 * * 08070051 * DATA AREAS: CCT(COMMON COMMUNICATION TABLE) CONTAINS ALL COMMONLY * 08100051 * USED ADDRESSES, FLAGS AND DATA AREAS. * 08130051 * * 08160051 * MACROS: NONE * 08190051 * * 08220051 * FUNCTION: CSECT AMDSADM2: THIS ROUTINE GENERATES THE APPROPRIATE * 08250051 * CODE FOR THE TYPE OF DUMP REQUESTED BY THE MACRO * 08280051 * PARAMETERS. * 08310051 * * 08340051 * CSECT AMDSAIP1: THIS ROUTINE IS THE IPL1 RECORD WHICH * 08370051 * READS IN THE IPL2 RECORD. * 08400051 * * 08430051 * CSECT AMDSAIP2: THIS ROUTINE IS THE IPL2 RECORD WHICH * 08460051 AIF ('&IPL2'(1,1) EQ 'D').PRO88 08490051 * READS IN THE AMDSAHSR ROUTINE. * 08520051 AGO .PRO87 08550051 .PRO88 ANOP 08580051 * READS IN THE AMDSAPRO ROUTINE. * 08610051 .PRO87 ANOP 08640051 * * 08670051 AIF ('&TYPE2' EQ 'LO').PRO86 08700051 * CSECT AMDSAHSR: THIS IS THE HIGH SPEED REAL DUMP * 08730051 * ROUTINE WHICH DUMPS REAL STORAGE TO AN OUTPUT TAPE DEVICE 08760051 * AT TAPE SPEED. * 08790051 AGO .PRO85 08820051 .PRO86 ANOP 08850051 * CSECT AMDSALSR: THIS IS THE LO SPEED REAL DUMP ROUTINE * 08880051 AIF ('&OUTPUT2'(1,1) EQ 'P').PRO84 08910051 * WHICH FORMATS AND DUMPS STORAGE TO A TAPE OUTPUT DEVICE * 08940051 AGO .PRO85 08960051 .PRO84 ANOP 08980051 * WHICH FORMATS AND DUMPS STORAGE TO A PRINTER OUTPUT DEVICE 09000051 .PRO85 ANOP 09020051 * * 09040051 * CHANGE ACTIVITY : * 09054700 * A390100,C028400 @ZA13019* 09069400 * C028400,A078300,C0774800,C077600,A077700 @ZA14121* 09084100 * C0-999999 (RESEQUENCED) @ZA17663* 09098800 * C265830,A265860-265920 @ZA19025* 09113500 * C022800,C265800,A265950-266370,A377410-377550, @ZA17663* 09128200 * A800401-800418,A800700-800800 @ZA17663* 09142900 * D377700-384600 MOVED TO 800420-800560 @ZA17663* 09157600 * A800420-800560 MOVED FROM 377700-384600 @ZA17663* 09172300 * C022800, A286530-286770, A484570-484710, C486300, A486100, @ZA24157* 09187000 * C486300 @ZA24157* 09201700 * A012700,C022800 @G51AGSG* 09216400 * D360900-377400 MOVE TO 802205-802480 @ZA24157* 09231100 * A802205-802480 MOVE FROM 360900-377400 @ZA24157* 09245800 * MACHINE CHECK HANDLER ADDED (EXTENSIVE RENUMBERING) @ZA27964* 09260500 * PSW AT LABEL IOENBL/IODSBL IN ERROR @ZA41033* 09275200 * SUPPORT NEW OPTIONAL 14 BIT 327X SCREEN ADDRESSING @ZA52618* 09289900 * DISABLED TIO LOOP CORRECTED FOR TAPE RESIDENT VERSIONS @ZA57190* 09311900 * DISABLED TIO LOOP CORRECTED FOR ALL TYPE=HI VERSIONS @ZA56338* 09322900 * * 09324700 *REASON MM/DD/YY ORIGIN DESCRIPTION * 09326500 *OZ62573 09/28/82 GT4517 LEVEL SET SADMP MODULES FOR SMP PROBLEMS * 09328300 *OZ67833 10/14/83 GT4517 TIOLOOP AFTER MSGAMD001A @ZA67833* 09329200 *OZ69934 10/03/83 GT4517 LOWSPEED FAILS AFTER SYS RESET CLEAR@ZA69934* 09329600 * * 09330100 * * 09331900 *.FX4 ANOP @ZA57190 09334000 ********************************************************************** 09350051 EJECT 09360051 .* MACRO SECTION 2 @ZA27964 09370051 AIF ('&IPL2'(1,1) EQ 'D').DAIPL SET UP DA IPL RCD 09420051 .TAPEIPL ANOP TAPE IPL TEXT 09440051 AMDSAIP1 CSECT 09460051 PGMPSW1 DC XL5'0008000000' IPL PSW 09480051 DC AL3(ENTRY) ENTRY POINT ADDR 09500051 TAPCCW1 CCW TPEREAD,WORKCCW1,X'60',TIPL2LNG IPL CCW1 09520051 TAPCCW2 CCW TICMD,WORKCCW1,X'60',X'01' IPL CCW2 09540051 SPACE 10 09560051 ORG AMDSAIP1+X'110' ORG CSECT TO LOC 272 ABSOLUTE 09580051 AMDSAIP2 CSECT 09600051 TAPCCW3 CCW TPEWRTE,CCT,X'60',RPPLNGTH WRT WK RCD FROM 7000 09620051 CCW TPEWRTE,CCT+TPRECLEN,X'60',RPPLNGTH WRT FROM D000 09640051 CCW REWIND,CCT,X'60',RPPLNGTH REWIND TAPE TO BEGINNING 09660051 CCW TPEREAD,CCT,NODATA,IPLNGTH READ BY THE IPL 1 TXT 09680051 CCW TPEREAD,CCT,X'60',RPPLNGTH-IPLNGTH READ IN PROG 09700051 CCW TPEREAD,CCT,NODATA,TIPL2LG2 PASS IPL2 TEXT @ZA14121 09720051 CCW TPEREAD,CCT+TPRECLEN-IPLNGTH,X'60',RPPLNGTH-TIPL2LG2 09740051 * @ZA14121 09760051 CCW TPEREAD,CCT,HEX70,RPPLNGTH SPACE PAST WORK RCD 09780051 CCW TPEREAD,CCT,HEX30,RPPLNGTH SPACE PAST RCD 2 09800051 TIPL2LNG EQU *-AMDSAIP2 @ZA08997 09820051 TIPL2LG2 EQU 144 @ZA14121 09840051 ORG AMDSAIP2+X'6EF0' 09860051 AGO .REALCDE START DUMP PROGRAM 09880051 .DAIPL ANOP D.A. IPL TEXT 09900051 AMDSAIP1 CSECT 09920051 PGMPSW1 DC XL8'0008000000007830' EC MODE PSW 1 09940051 DACCW1 CCW DAREAD,DACCW3,X'60',DIPL2LNG READ INTO LOC 272 09960051 DACCW2 CCW TICMD,DACCW3,X'60',X'01' GIVE CONTROL TO IPL2 09980051 SPACE 10 10000051 ORG AMDSAIP1+X'110' SET UP TO LOC 272 10020051 AMDSAIP2 CSECT 10040051 DACCW3 CCW SRCHCCW,DASRADDR+6,X'60',SRCHLNGH GET WORK RCD 10060051 CCW TICMD,DACCW3,X'60',SRCHLNGH TIC UNTIL FOUND 10080051 CCW DAWRITE,X'7800',X'60',DUMPDUMP WRITE WORK RECORD 10100051 CCW TICMD,DACCW4,X'60',1 TIC TO WRITE 10120051 DASRADDR DC 4F'0' DASDR AREA 10140051 DACCW4 CCW DAREAD,CCT+HEX800,X'60',DUMPDUMP RD INTO X'7800' 10160051 CCW TICMD,X'7800',X'60',1 TIC TO PRO CHANNEL PGM 10180051 DUMPDUMP EQU 2048 LENGTH OF REAL DUMP PGM 10200051 DIPL2LNG EQU 64 IPL2 LENGTH 10220051 ORG AMDSAIP2+X'6EF0' 10240051 AIF ('&TYPE2' EQ 'LO').LOPRO GET PROPER CSECT @ZA00418 10260051 .REALCDE ANOP @ZA00418 10280051 SPACE 10 10300051 ********************************************************* @ZA00418 10620051 ** CSECT'S REQUIRED FOR LOADER MAKER REFERENCES ** @ZA00418 10650051 ********************************************************* @ZA00418 10680051 AMDSAHSR CSECT HI SPEED CSECT @ZA00418 10710051 AGO .ENTRY @ZA00418 10740051 .LOPRO ANOP @ZA00418 10770051 AMDSALSR CSECT LO SPEED CSECT @ZA00418 10800051 AMDSAHSR EQU * @ZA56338 10815000 .ENTRY ANOP REAL DUMP ENTRY POINT 10830051 EJECT 10850051 ********************************************************************** 10890051 * * 10920051 * COMMON CONTROL TABLE DEFINITION (REFERRED TO AS CCT) * 10950051 * * 10980051 ********************************************************************** 11010051 SPACE 11040051 USING *,BASEREG 11070051 CCT EQU * COMMON CONTROL TABLE;REAL DUMP SECT 11090051 CTWAIT DC XL1'00' WAIT STATE CODE 11110051 CTFLG1 DC XL1'00' FLAGS 11130051 CTERROR EQU X'80' CALLER ERROR RECOVERY 11150051 CTDEVICE EQU X'40' DA IO IN PROGRESS 11170051 CTMORTPE EQU X'20' END OF REEL 11190051 CTWORK EQU X'10' WK RCD IN PROGRESS 11210051 CTDEFO EQU X'08' DEFAULT OUTPUT ADDR 11230051 CTDEFW EQU X'04' DEFAULT WKFILE ADDR 11250051 CTMP EQU X'02' MP SYSTEM 11270051 CTERREC EQU X'01' IGNORE CATASTROPHIC ERRORS 11290051 CTFLG2 DC XL1'00' FLAGS 11310051 CTDUPSW EQU X'80' DUPLICATE LINE 11330051 CTSTOR EQU X'40' PROTECT KEY IN PROGRESS 11350051 CTPGEFLT EQU X'20' PGE FAULT IN PROGRESS 11370051 CTNOSTAT EQU X'10' STORE STATUS NOT DONE 11390051 CTVIRTR EQU X'08' VIRTUAL DUMP REQUESTED 11410051 CTWKDONE EQU X'04' END OF WKFILE PROCESSING 11430051 CTALTCON EQU X'02' ALT CONSOLE IN USE 11450051 CTNOWORK EQU X'01' NO WKFILE DONE 11470051 AIF ('&IPL2'(1,1) EQ 'T').TDEV 11490051 CTDEVTYP DC XL1'00' IPL DEVICE TYPE IS DASD @ZA27964 11510051 AGO .CCTSENS 11520051 .TDEV ANOP 11530051 CTDEVTYP DC XL1'01' IPL DEVICE TYPE IS TAPE @ZA27964 11540051 .CCTSENS ANOP 11590051 CTSENSE DC XL2'0000' SENSE INFORMATION 11610051 CTINADDR DC XL2'0000' IPL DEVICE ADDR 11630051 CTCCHHR DC XL8'0000000000000000' .CCHHR DURING IPL 11650051 CTCCHHS DC XL4'00000000' SYS1.PAGEDUMP START 11670051 CTCCHHE DC XL4'00000000' SYS1.PAGEDUMP END 11690051 CTCCHHW DC XL4'00000000' WKFILE START 11710051 CTERBDA DC XL4'00000000' DA ERROR RECOVERY 11730051 CTBRANCH B SAVECSW 11750051 CTERBTPE EQU CTBRANCH TAPE ERROR RECOVERY 11770051 CTERBPTR EQU CTBRANCH SET PTR = TAPE 11790051 CTERBCON DC XL4'00000000' CONSOLE ERROR RECOVERY 11810051 CTCPUI DC XL2'0000' IPL CPU ADDR 11830051 CTOUTAD DC XL2'0000' OUTPUT DEVICE ADDRESS 11850051 AIF ('&CONSOLE' EQ 'B').GCON 11870051 AIF ('&CONSOLE' EQ 'C').GCON 3158/3277 TYPE GRAPHICS @ZA00418 11890051 CTCONTYP DC XL1'01' NON GRAPHIC CONSOLE 11910051 AGO .CTCON 11930051 .GCON ANOP 11950051 CTCONTYP DC XL1'02' GRAPHIC CONSOLE 11970051 .CTCON ANOP 11990051 CTEBCOPD DC CL3'&OUTPUT' DEFAULT OUTPUT DEV ADDR 12010051 AIF ('&TYPE2' EQ 'HI').REALFLG 12030051 AIF ('&ADDR2' EQ 'REAL').REALFLG 12050051 CTLOWFLG DC XL1'80' DEFAULT TO VIRTUAL DUMP 12070051 AGO .VIRTBIT 12090051 .REALFLG ANOP 12110051 CTLOWFLG DC XL1'00' DEFAULT TO REAL DUMP 12130051 .VIRTBIT ANOP 12150051 CTVIRTD EQU X'80' DEFAULT TO VIRTUAL DUMP 12170051 CTFP EQU X'40' FP TAPE BIT 12190051 CTINIT EQU X'20' INITIALIZATION IN PROGRESS 12210051 CTWKSTUS EQU X'10' STATUS OF WKFILE RCDS 12230051 CTEBCOPR DC XL3'000000' REPLIED OUTPUT DEVICE 12250051 .* @ZA27964 12270051 AIF ('&TYPE2' EQ 'LO').CCTLO 12280051 .* @ZA27964 12290051 CTIOTYPE DC XL1'00' I/O REQUEST FLAGS 12330051 DC XL1'00' RSVD 12350051 CTCONFLG DC XL1'00' CONSOLE FLAGS 12370051 CTMSGOUT EQU X'80' MSG MUST COME OUT 12390051 CTBUFTYP DC XL1'00' BUFFER TYPE FLAGS 12410051 CTCONSOL DC AL4(CONSOLE) CONSOLE ROUTINE 12430051 CTLWKAD DC XL4'00000000' LAST ADDR ON WKFILE 12450051 CTCOMMIO DC AL4(DUMPSIO) ADDR OF DUMPSIO ROUTINE 12470051 CTEOR DC AL4(MORTAPE) ADDRESS OF EOR ROUTINE 12490051 CTVCCT DC XL4'00000000' ADRESS OF VCCT 12510051 AIF ('&CONSOLE' EQ 'C').CTPRMT1 GIVE SPECIAL @ZA00418 13200051 * INITIAL SETTING TO NEXT DC FOR 3277/3158 INTERFACE WITH @ZA00418 13230051 * THE SACON MODULE @ZA00418 13260051 CTPRMT1 DC XL2'2100' PRIMARY PROMPT POSITION @YM04419 13290051 AGO .CTPRMT2 @ZA00418 13320051 .CTPRMT1 ANOP @ZA00418 13350051 CTPRMT1 DC XL2'0000' SPECIAL SETTING TO TRIGGER SACON @ZA00418 13380051 .CTPRMT2 ANOP @ZA00418 13400051 CTPRMT2 DC XL2'0000' SECONDARY PROMPT POSITION 13420051 CTHWM DC XL1'20' LOGICAL 3066 SCREEN LIMIT 13440051 CTHWMAX DC XL1'21' PHYSICAL SCREEN LIMIT 13460051 DC XL2'00' RESERVED 13480051 AGO .CCTEND 13500051 .CCTLO ANOP 13520051 CTADDRS DC XL4'00000000' STARTING ADDR DUMP RANGE 13540051 CTADDRE DC XL4'00000000' ENDING ADDR DUMP RANGD 13560051 AIF ('&CONSOLE' EQ 'C').CTPRMT3 GIVE SPECIAL @ZA00418 13680051 * INITIAL SETTING TO NEXT DC FOR 3277/3158 INTERFACE WITH @ZA00418 13710051 * THE SACON MODULE @ZA00418 13740051 CTPRMT1 DC XL2'2100' PRIMARY PROMPT POSITION @YM04419 13770051 AGO .CTPRMT4 @ZA00418 13800051 .CTPRMT3 ANOP @ZA00418 13830051 CTPRMT1 DC XL2'0000' SPECIAL SETTING TO TRIGGER SACON @ZA00418 13860051 .CTPRMT4 ANOP @ZA00418 13880051 CTPRMT2 DC XL2'0000' SECONDARY PROMPT POSITION 13900051 CTHWM DC XL1'20' LOGICAL 3066 SCREEN LIMIT 13920051 CTHWMAX DC XL1'21' PHYSICAL SCREEN LIMIT 13940051 DC XL2'00' RESERVED 13960051 .* MACRO SECTION 3 @ZA27964 13980051 AIF ('&OUTPUT2'(1,1) NE 'P').LOHEAD @Z40MI3F 13990051 .* @ZA27964 14000051 CT3800 DC XL1'1' 3800 PRINTER SWITCH @Z40MI3F 14040051 AGO .LOHEAD 14060051 .CCTEND ANOP 14080051 SPACE 5 14100051 ********************************************************************** 14120051 * * 14140051 * THIS CODE DEFINES THE DUMP HEADER RECORD AND MAPS DUMP RECORD FMT * 14160051 * * 14220051 ********************************************************************** 14250051 SPACE 14280051 DUMPRCD DS 0F @ZA00418 14310051 HDRID DC XL1'FF' HEADER ID 14340051 RECID DC XL1'FF' RECORD ID 14370051 ASID DC XL2'0000' ASID BEING DUMPED 14400051 DUMPNAME DC CL8'AMDSADMP' NAME OF DUMP PROGRAM 14430051 DUMPTIME DC F'0' TIME OF DUMP 14460051 DUMPDATE DC F'0' DATE OF DUMP 14490051 DUMPTITL DC 25CL4' ' TITLE OF DUMP 14520051 DUMPCSW DC 2F'0' CSW AT TIME OF DUMP 14550051 DUMPCAW DC F'0' CAW AT TIME OF DUMP 14580051 KEY1 EQU HDRID STORAGE KEY 14610051 KEY2 EQU RECID STORAGE KEY 14640051 ADDR EQU DUMPNAME ADDRESS BEING DUMPED 14670051 STAFLAGS EQU ASID RECORD FLAGS 14700051 RESERVD EQU ASID+1 RSVD FIELD 14730051 CPUADDR EQU DUMPNAME+2 CPU RCD BEING DUMPED 14760051 HEADLNGH EQU DUMPTITL+68 SET UP FOR DUMP TITLE LENGTH 14790051 AGO .CONS SET UP FOR CONSOLE INFO 14820051 .LOHEAD ANOP LO SPEED DUMP HEADER RCD 14850051 SPACE 14880051 DUMPCSW EQU 12 LOC OF CSW AT TIME OF DUMP 14910051 DUMPCAW EQU 20 LOC OF CAW AT TIME OF DUMP 14940051 .* MACRO SECTION 4 @ZA27964 14970051 .CONS ANOP CONSOLE ROUTINE CODE 15000051 EJECT 15030051 ********************************************************************** 15240051 * * 15270051 * CONSOLE ROUTINE. THIS ROUTINE IS GENERALIZED TO PERFORM TWO * 15300051 * BASIC FUNCTIONS, READING AND WRITING FROM A CONSOLE DEVICE. THE * 15330051 * CALLING SEQUENCE MUST BE AS FOLLOWS: * 15360051 * BAL 14,CONSOLE * 15390051 * NORMAL RETURN * 15420051 * * 15450051 * INPUT REQUIREMENTS: R6 ADDR OF MSG TO OUTPUT * 15480051 * HIGH ORDER BYTE LENGTH OF MSG * 15510051 * R5 READ INPUT AREA * 15540051 * HIGH ORDER BYTE INPUT MSG LENGTH * 15570051 * R15: RETURN CODE: 0=NORMAL RETURN * 15600051 * 4=CONSOLE NOT * 15630051 * AVAILABLE * 15660051 * 8=CONSOLE I/O * 15690051 * ERROR * 15720051 * * 15750051 ********************************************************************** 15780051 SPACE 15810051 .* @ZA27964 15840051 AIF ('&CONSOLE' EQ 'B').GRAPHIC FOR GRAPHIC CONSOLE SEP PROC 15850051 AIF ('&CONSOLE' EQ 'C').CON3158 TEST FOR 3158/3277 @ZA00418 15860051 .* @ZA27964 15870051 CONADDRX DS 0H @ZA57190 15907200 DC XL2'&CONADDR' CONSOLE ADDRESS @ZA57190 15913400 CONSOLE DS 0H THE CONSOLE READ/WRITE ENTRY POINT 15920051 LA RETCODE,4 SET UP ERROR RETURN CODE.THIS IS DONE 15940051 * TO MINIMIZE THE CODE REQUIRED TO SET 15960051 * RETURN CODES 15980051 CONSOLBA DS 0H 16000051 LH IODEVREG,CONADDRX OBTAIN CONSOLE ADDR TO CHECK @ZA57190 16020000 CONTIOLP DS 0H CLEAR CONSOLE STATUS 16040051 AIF ('&TYPE2' NE 'HI').FX7 @ZA56338 16044200 BAL TIOREG,TIOLOOP @ZA56338 16048400 AGO .PFX7 @ZA56338 16052600 .FX7 ANOP @ZA57190 16056800 TIO 0(IODEVREG) IS THE CONSOLE AVAILABLE FOR I/O? 16060051 BC 2,CONTIOLP IF BUSY, WAIT UNTIL FREE 16120051 .PFX7 ANOP @ZA56338 16135700 CONNOTAV EQU *+1 USED TO CHANGE THE BRANCH CONDITION X16151400 TO 0 AFTER FINDING A CONSOLE @ZA56338 16167100 BC 1,ALTCONCK NOT AVAIL, CHECK FOR ALT CON @ZA56338 16182800 NI CONNOTAV,X'00' CHANGE BRANCH TO NOP TO PREVENT LATERX16198500 ENTRY INTO ALTERNATE CODE. @ZA56338 16214200 STCM OUTREG,HEX7,CONWRITE+1 PLACE THE OUTPUT ADDR 16230051 * IN THE CONSOLE OUTPUT CCW 16260051 STCM OUTREG,HEX8,CONWRITE+7 PLACE THE DATA COUNT 16290051 * IN THE CONSOLE OUTPUT CCW 16320051 LTR INREG,INREG DETERMINE IF A READ IS TO OCCUR 16350051 * AFTER THE WRITE 16370051 BNZ CONSWTE YES, A READ FOLLOWS, SET 16390051 * UP THE READ CCW'S 16410051 MVI CONHEAD,AUTO NO, SET UP WRITE WITH AUTO 16430051 * CARRIAGE RETURN 16450051 NI CONWRITE+4,HEX20 DO NOT CMD CHAIN TO READ 16470051 B CONSWRTE WRITE OUT THE MSG 16490051 CONSWTE DS 0H HANDLE I/O FOR READ AND WRITE 16510051 MVI CONHEAD,NOAUTO MAKE CCW A WRITE WITH 16530051 * NO AUTOMATIC CARRIAGE RETURN 16550051 OI CONWRITE+4,HEX40 .SET UP CMD CHAIN TO READ 16570051 STCM INREG,HEX7,CONREAD+1 PLACE THE INPUT ADDR IN 16590051 * THE CONSOLE INPUT CCW 16610051 STCM INREG,HEX8,CONREAD+7 SET UP LENGTH OF READ 16630051 CONSWRTE DS 0H FOR THE MSG I/O PROCESSING 16650051 LA CCWREG,CONCCW OBTAIN THE CCW ADDRESS FOR I/O 16670051 OI CTFLG1,CTERROR INDICATE THIS RTN HANDLES ERRS 16690051 BAL RETREG,DUMPSIO GO WRITE OUT THE MSG 16710051 TM CSW+4,X'01' CHECK FOR UNIT EXCEPTION-OPERATOR 16730051 * HAS CANCELLED THE REPLY 16750051 BNO ACANCELR IF OPERATOR CANCELLED REPLY, REISSUE 16770051 * THE ERROR MESSAGE 16790051 IC RETCODE,CONREAD+7 .UNDER CANCEL SET TO BLANK 16810051 BCTR RETCODE,0 BLANK OUT INPUT AREA 16830051 EX RETCODE,REREPLY BLANK IT OUT 16850051 B CONSOLE GO REPEAT THE MESSAGE 16870051 ACANCELR DS 0H SET UP CANCEL BYPASS 16890051 AR RETCODE,RETCODE SET UP POSSIBLE I/O ERROR CODE OF 8 16910051 TM CTFLG1,CTERROR DID AN I/O ERROR OCCUR? 16930051 BCR 14,CREG YES, GO TO USER ERROR EXIT (BNO COND) 16950051 NI CTFLG1,HEXFF-CTERROR .RESET THE ERROR FLAG 16970051 SR RETCODE,RETCODE SET THE NORMAL RETURN CODE OF ZERO 16990051 BR CREG RETURN TO CALLER--NORMAL 17010051 SPACE 17370051 ********************************************************************** 17400051 * * 17430051 * THIS SECTION DESCRIBES THE CHANNEL PROGRAMS FOR THE CONSOLE * 17460051 * DEVICES SUPPORTTED. * 17490051 * * 17520051 * * 17550051 * THIS CODE IS FOR THE 1052 TYPE CONSOLE. THIS INCLUDES THE * 17580051 * 1052,2150,3210, AND THE 3215 * 17610051 * * 17640051 ********************************************************************** 17670051 SPACE 17700051 CONCCW DS 0D CONSOLE CCW'S 17730051 CONHEAD CCW X'01',MSGHEAD,HEXA0,X'04' MSG ID CCW 17750051 CONWRITE CCW X'01',CONCCW,X'60',X'01' SET UP TO WRITE 17770051 CONREAD CCW X'0A',CONCCW,HEX20,TITLEN SET UP TO READ 17790051 AUTO EQU X'09' AUTOMATIC CARR RETURN CODE 17810051 NOAUTO EQU X'01' NO AUTO CARR RETURN CODE 17830051 MSGHEAD DC C'AMD0' MESSAGE HEADER FOR ALL MESSAGES 17890051 REREPLY XC 0(0,INREG),0(INREG) BLANK OUT REPLY AREA ON CANCEL 17910051 AGO .ALTCON GO TO ALT-CONSOLE 17930051 .GRAPHIC ANOP HANDLE GRAPHIC CONSOLE 17950051 CONADDRX DS 0H @ZA57190 17966800 DC XL2'&CONADDR' CONSOLE ADDRESS @ZA57190 17968200 CONSOLE1 DS 0H RETRY ENTRY POINT TO CONSOLE RTN 17970051 IC RETCODE,CONREAD+7 .UNDER CANCEL SET TO BLANK 17990051 BCTR RETCODE,0 BLANK OUT INPUT AREA 18010051 EX RETCODE,REREPLY BLANK IT OUT 18030051 CONSOLE DS 0H THE CONSOLE READ/WRITE ENTRY POINT 18050051 LA RETCODE,4 SET UP ERROR RETURN CODE.THIS IS DONE 18070051 * TO MINIMIZE THE CODE REQUIRED TO SET 18090051 CONSOLBA DS 0H 18110051 LH IODEVREG,CONADDRX OBTAIN CONSOLE ADDR TO CHECK @ZA57190 18130000 CONTIOLP DS 0H CLEAR CONSOLE STATUS 18150051 AIF ('&TYPE2' NE 'HI').FX9 @ZA56338 18154200 BAL TIOREG,TIOLOOP @ZA56338 18158400 AGO .PFX9 @ZA56338 18162600 .FX9 ANOP @ZA57190 18166800 TIO 0(IODEVREG) IS THE CONSOLE AVAILABLE FOR I/O? 18170051 .PFX9 ANOP @ZA56338 18178500 CONNOTAV EQU *+1 USED TO CHANGE THE BRANCH CONDITION X18187000 TO 0 AFTER FINDING A CONSOLE @ZA56338 18195500 BC 1,ALTCONCK NOT AVAIL, CHECK FOR ALT CON @ZA56338 18204000 NI CONNOTAV,X'00' CHANGE BRANCH TO NOP TO PREVENT LATERX18212500 ENTRY INTO ALTERNATE CODE. @ZA56338 18221000 IC RETREG,CTPRMT1 SET UP TO OBTAIN CURRENT Y POINTER 18230051 * * 18510051 * NOTE: GRAPHICS PROCESSING ON A 3066 IS AS FOLLOWS: * 18540051 * A BUFFER ADDRESS MUST BE SET ON THE SCREEN VIA A SET* 18570051 * BUFFER ADDRESS CCW. THE SET BUFFER ADDRESS REFERS * 18600051 * TO THE SCREEN AS AN X-Y COORDINATE SYSTEM, WHERE * 18630051 * THE X AXIS IS UP TO 80(BASE 10) BYTES LONG (SCREEN * 18660051 * WIDTH) AND Y IS UP TO 34(BASE 10) BYTES LONG * 18690051 * (SCREEN LENGTH). THIS IS POINTED TO BY A SET BUFFER* 18720051 * ADDRESS WITH Y AS THE FIRST BYTE IN THE BUFFER * 18750051 * AND X AS THE SECOND BYTE IN THE BUFFER. * 18780051 * CTPRMT (1 AND 2) ARE AS FOLLOWS: * 18810051 * BYTE 0 BYTE 1 * 18840051 * Y AXIS DISPL X AXIS DISPLACEMENT * 18870051 * * 18900051 LA RETREG,1(RETREG) INCREMENT Y AXIS BY 1 TO NEXT LINE 18930051 SLL RETREG,8 SHIFT BY 1 BYTE (NOTE THIS ZEROS X 18950051 * AXIS FOR THE NEXT LINE 18990051 STCM RETREG,HEX3,CTPRMT1 SAVE Y-X COORDINATES FOR SET BUFFER 19020051 * ADDRESS CCW FOR CHANNEL PROGRAM 19050051 STCM OUTREG,HEX7,CONWRITE+1 SET UP THE OUTPUT ADDR IN CCW 19080051 STCM OUTREG,HEX8,CONWRITE+7 SET UP THE OUTPUT MSG LNGTH 19110051 MVI CONWRITE+4,HEX20 SET UP FOR WRITE MSG ONLY-NO COMMD 19140051 * CHAINING TO READ CCW'S 19160051 LTR INREG,INREG IS A READ TO FOLLOW? 19180051 BZ CONTEST NO, GO OUTPUT MESSAGE 19200051 STCM INREG,HEX7,CONREAD+1 SAVE READ INPUT ADDR AREA 19220051 STCM INREG,HEX8,CONREAD+7 SAVE READ INPUT LENGTH IN CCW 19240051 MVI CONWRITE+4,X'60' CHAIN UP READ TO WRITE CCW'S 19260051 IC RETREG,CONWRITE+7 .OBTAIN READ LENGTH FOR Y-X AXIS 19280051 LA RETREG,4(RETREG) BUMP BY 4 (MSG HEADER LENGTH) 19300051 STCM RETREG,HEX3,CTPRMT2 .SET UP Y-X FOR READ AREA 19320051 * NOTE RETREG HAS Y AXIS STILL IN 19340051 * BYTE 2 OF REGISTER 19360051 CONTEST DS 0H TEST STATUS OF SCREEN 19380051 LA CCWREG,CONSLCCW OBTAIN CONSOLE CCW ADDR 19400051 CLC CTPRMT1(1),CTHWM ARE WE OVER SCREEN DANGER POINT ON 19420051 * FILLING THE GRAPHICS SCREEN 19440051 BL CWRITE NO, GO WRITE OUTPUT MESSAGE 19460051 AIF ('&TYPE2' EQ 'LO').CERASE IF TYPE=LO, TEST NOT REQUIRED 19650051 TM CTCONFLG,CTMSGOUT .TEST IF MSG MUST GO OUT--RELATED 19680051 * TO PRIOR MSG SO SCREEN MUST NOT BE 19710051 * ERASED AT THIS TIME 19740051 BNO CERASE NOT CONDITIONAL MSG-ERASE SCREEN 19770051 CLC CTPRMT1(1),CTHWMAX OVER MAXIMUM SCREEN LIMIT? 19790051 BL CWRITE NO, OUTPUT MESSAGE 19810051 .CERASE ANOP ERASE SCREEN CONDITION 19830051 CERASE DS 0H SET UP TO ERASE SCREEN 19850051 LA CCWREG,CONERASE SET UP ERASE CCW 19870051 XC CTPRMT1(3),CTPRMT1 SET UP Y-X AS 00&00 19890051 CWRITE DS 0H OUTPUT MESSAGE 19910051 OI CTFLG1,CTERROR SET UP TO DETERMINE IF I/O ERR 19930051 BAL RETREG,DUMPSIO GO ISSUE CONSOLE I/O 19950051 AR RETCODE,RETCODE SET UP FOR CC=8 IF I/O ERR 19970051 TM CTFLG1,CTERROR DID AN I/O ERROR OCCUR? 19990051 BCR 14,CREG YES, RETURN TO CALLER RC=8 20010051 LTR INREG,INREG IS A READ TO FOLLOW? 20030051 BZ COK NO, CONSOLE PROCESSING IS COMPLETED 20050051 CLOOP DS 0H SET UP TO WAIT FOR ATTENTION FROM 20070051 AIF ('&TYPE2' EQ 'HI').FX1 @ZA56338 20080000 TIO 0(IODEVREG) THE GRAPHICS DEVICE-THIS 20090051 AGO .PFX1 @ZA57190 20094000 .FX1 ANOP @ZA57190 20098000 BAL TIOREG,TIOLOOP @ZA58851 20102000 .PFX1 ANOP @ZA57190 20106000 BC 11,CLOOP INDICATES THE OPERATOR HAS ENTERED 20110051 * INPUT-DATA OR A CANCEL 20130051 TM CSW+4,HEX82 WAIT FOR ATTNQ OR UNIT CHECK OR BOTH 20150051 BZ CLOOP IF NEITHER WAIT 20170051 BCR 1,CREG WAS ATTNQ AND UNIT CHECK THIS IS 20190051 * AN I/O ERROR CONDITION-RETURN 20210051 * TO CALLER WITH RC=8 20230051 LA CCWREG,CONMAN ATTNQ ONLY-INPUT IS READY 20250051 * TO BE READ. ON GRAPHICS CONSOLE 20270051 * MUST LOOK AT BUFFER TO DETERMINE 20290051 * WHAT HAPPENED (ENTER OR CANCEL). 20310051 BAL RETREG,DUMPSIO DO I/O FROM BUFFER 20330051 TM CTFLG1,CTERROR DID AN ERROR OCCUR? 20350051 BCR 14,CREG YES, EXIT TO CALLER RC=8 20370051 TM MINPUT+2,CANCELM WAS CANCEL ENTERED? 20390051 BO CONSOLE1 YES, ZERO BUFFER & REPEAT MSG 20410051 COK DS 0H NORMAL CONSOLE RETURN AREA 20430051 NI CTFLG1,HEXFF-CTERROR .RESET THE ERROR FLAG 20450051 SR RETCODE,RETCODE SET THE NORMAL RETURN CODE OF ZERO 20470051 BR CREG RETURN TO CALLER--NORMAL 20490051 .GC3066 ANOP GRAPHIC CCW FOR 3066 20880051 SPACE 20910051 ********************************************************************** 20940051 * * 20970051 * THIS CODE IS FOR THE 3066 TYPE CONSOLE. THIS INCLUDES THE * 21000051 * 3066 CONSOLE DEVICE TYPE * 21030051 * * 21060051 ********************************************************************** 21090051 SPACE 21120051 CONCCW DS 0D SET UP GRAPHICS CCW AREA 21150051 CONERASE CCW ERASECMD,CTPRMT1,X'60',X'01' ERASE COMMAND FOR 3066 21170051 CONSLCCW CCW SETBUFAD,CTPRMT1,X'60',X'02' SET BUFFER ADD FOR 3066 21190051 CONHEAD CCW WRITECMD,MSGHEAD,HEXA0,X'04' WRITE HEADER RECORD 21210051 CONWRITE CCW WRITECMD,CONCCW,X'60',X'01' WRITE CMD FOR MSG 21230051 CONSETC CCW SETCURS,CTPRMT2,HEX20,X'02' SET CURSOR FOR READ 21250051 SPACE 21270051 * THE FOLLOWING CCW'S ARE FOR 3066 READ COMMAND FUNCTIONS 21290051 SPACE 21310051 CONMAN CCW LOCKCCW,MINPUT,X'60',X'01' LOCK UP 3066 KEYBOARD 21330051 CONRMI CCW READMAN,MINPUT,X'60',X'03' READ MANUAL INPUT FOR Y-X-CC 21350051 CONSETA CCW SETBUFAD,CTPRMT2,X'60',X'02' RESET BUFFER ADDR FOR READ 21370051 CONREAD CCW READCMD,CONCCW,HEX20,X'01' READ COMMAND TO READ INPUT 21390051 SPACE 21410051 * THE FOLLOWING ARE 3066 EQUATES 21430051 SPACE 21450051 LOCKCCW EQU X'67' LOCK KEYBOARD COMMAND ON 3066 21470051 ERASECMD EQU X'07' ERASE COMMAND ON 3066 21490051 SETBUFAD EQU X'27' SET BUFFER ADDRESS COMMAND CODE 21510051 WRITECMD EQU X'01' CONSOLE WRITE COMMAND 21530051 SETCURS EQU X'0F' SET CURSOR COMMAND 21550051 READMAN EQU X'0E' READ MANUAL INPUT COMMAND CODE 21570051 READCMD EQU X'06' READ COMMAND ON 3066 21590051 MINPUT EQU CONWRITE+1 SET UP RMI IN CCW-THIS IS UNUSED 21610051 * DURING THE READ OPERATION 21630051 DS 0F 21670051 MSGHEAD DC C'AMD0' MESSAGE HEADER FOR ALL MESSAGES 21710051 REREPLY XC 0(0,INREG),0(INREG) BLANK OUT REPLY AREA ON CANCEL 21730051 YCURSOR EQU MINPUT Y CURSOR SETTING FROM RMI(READ MANUAL 21750051 * COMMAND) WHICH GIVES Y-X-CC 21770051 XCURSOR EQU MINPUT+1 X CURSOR SETTING FROM RMI 21790051 ENTERM EQU X'80' ENTER SETTING IN RMI-EQU TO MINPUT+2 21810051 CANCELM EQU X'40' CANCEL SETTING IN PMI-EQU TO MINPUT+2 21830051 AGO .ALTCON @ZA00418 22200051 .CON3158 ANOP @ZA00418 22230051 SPACE 1 @ZA00418 22260051 *********************************************************** @ZA00418 22290051 ** ** @ZA00418 22320051 ** THIS SECTION OF CODE SUPPORTS THE 3158/3277 ** @ZA00418 22350051 ** TYPE OF OPERATOR CONSOLES ** @ZA00418 22380051 ** ** @ZA00418 22410051 *********************************************************** @ZA00418 22440051 CONADDRX DS 0H @ZA57190 22465200 DC XL2'&CONADDR' CONSOLE ADDRESS @ZA57190 22467300 CONSOLE1 DS 0H ENTRY FOR RETRY @ZA00418 22470051 IC RETCODE,C3277CR3+7 GET REPLY LENGTH @ZA00418 22500051 BCTR RETCODE,0 ADJUST XC INSTRUCTION @ZA00418 22530051 EX RETCODE,REREPLY CLEAR REPLY AREA @ZA00418 22560051 CONSOLE DS 0H MAIN ENTRY POINT @ZA00418 22590051 LA RETCODE,4 PRESET RETURN CODE @ZA00418 22620051 LH IODEVREG,CONADDRX OBTAIN CONSOLE ADDR TO CHECK @ZA57190 22640000 CONTIOLP DS 0H @ZA00418 22660051 AIF ('&TYPE2' NE 'HI').FX11 @ZA56338 22664200 BAL TIOREG,TIOLOOP @ZA56338 22668400 AGO .PFX11 @ZA56338 22672600 .FX11 ANOP @ZA57190 22676800 TIO 0(IODEVREG) IS CONSOLE AVAILABLE @ZA00418 22680051 BC 2,CONTIOLP WAIT IF BUSY @ZA00418 22720051 .PFX11 ANOP @ZA56338 22731400 CONNOTAV EQU *+1 USED TO CHANGE THE BRANCH CONDITION X22742800 TO 0 AFTER FINDING A CONSOLE @ZA56338 22754200 BC 1,ALTCONCK NOT AVAIL, CHECK FOR ALT CON @ZA56338 22765600 NI CONNOTAV,X'00' CHANGE BRANCH TO NOP TO PREVENT LATERX22777000 ENTRY INTO ALTERNATE CODE. @ZA56338 22788400 ICM CCWREG,3,C3277FM1+2 GET PREVIOUS LINE ADDRESS @ZA00418 22800051 TM C3277FM1+3,X'30' WAS IT A 4TH LINE @ZA00418 22830051 BNO NXTADR NO ONLY ADD 1 @ZA00418 22860051 MVI ADDRCON+2,X'02' YES,SET TO ADD 2 @ZA00418 22890051 NXTADR DS 0H @ZA00418 22920051 AL CCWREG,ADDRCON BUMP TO NEXT LINE ADDRESS @ZA00418 22950051 MVI ADDRCON+2,X'01' RESET TO ADD 1 NEXT TIME @ZA00418 22980051 STCM CCWREG,3,C3277FM1+2 STORE ADDRESS @ZA00418 23010051 NI C3277FM1+3,X'30' CLEAR UNWANTED BITS @ZA00418 23040051 STCM OUTREG,HEX7,C3277CW2+1 SET CCW=MSG ADDR @ZA00418 23070051 STCM OUTREG,HEX8,C3277CW2+7 SET CCW=MSG LENGTH @ZA00418 23100051 CONTEST DS 0H @ZA00418 23130051 LA CCWREG,CONCCW PICK UP CCW CHAIN ADDR @ZA00418 23160051 CLI C3277FM1+2,X'D5' ONLY 3 LINES TO GO? @ZA52618 23190000 BL NXTEST NO,MORE THAN 3 @ZA00418 23220051 MVI CTPRMT1,X'20' YES,SET SACON MODULE SWITCH @ZA00418 23250051 NXTEST CLI C3277FM1+2,X'D7' IS IT LAST LINE ON SCREEN? @ZA52618 23280000 BL CWRITE NO,GO WRITE @ZA00418 23310051 BH CERASE BEYOND LAST LINE,GO ERASE @ZA00418 23340051 AIF ('&TYPE2' EQ 'LO').CERASE2 SKIP IF TYPE=LO @ZA00418 23370051 TM CTCONFLG,CTMSGOUT LAST LINE,IS MSG RELATED TO @ZA00418 23400051 BO CWRITE PREV MSG-YES,GO WRITE @ZA00418 23430051 .CERASE2 ANOP NO,CLEAR SCREEN @ZA00418 23460051 CERASE DS 0H @ZA00418 23490051 MVI CTPRMT1,X'00' RESET SACON SWITCH @ZA00418 23520051 LA CCWREG,ERASECCW GET ADDR OF ERASE CCW CHAIN @ZA00418 23550051 MVC C3277FM1+2(2),ADDRMASK RESET SCREEN ADDR=0000 @ZA52618 23580000 CWRITE DS 0H @ZA00418 23610051 OI CTFLG1,CTERROR RESET ERROR FLAG @ZA00418 23640051 BAL RETREG,DUMPSIO GO DO I/O @ZA00418 23670051 AR RETCODE,RETCODE PRESET I/O ERROR CODE @ZA00418 23700051 TM CTFLG1,CTERROR WAS I/O ERROR @ZA00418 23730051 BCR 14,CREG YES,RETURN TO CALLER,RC=8 @ZA00418 23760051 LTR INREG,INREG IS THERE A REPLY @ZA00418 23790051 BZ COK NO,GO FINISH @ZA00418 23820051 XC RBDS3277,RBDS3277 YES,RESET REPLY PREFIX AREA @ZA00418 23850051 CLOOP DS 0H @ZA00418 23880051 AIF ('&TYPE2' EQ 'HI').FX2 @ZA56338 23895000 TIO 0(IODEVREG) TEST FOR OPERATOR ACTION @ZA00418 23910051 AGO .PFX2 @ZA57190 23943000 .FX2 ANOP @ZA57190 23946000 BAL TIOREG,TIOLOOP @ZA56338 23956500 .PFX2 ANOP @ZA57190 23967000 BC 11,CLOOP NO ACTION,LOOP WAIT @ZA00418 23968500 CLI CSW+4,X'50' STATUS MODIFIER AND BUSY? @ZA67833 23969000 BE CUBUSY ENABLE TO CLEAR INTERRUPT @ZA67833 23969500 TM CSW+4,HEX82 YES,WAS IT ATTN OR UNIT CHK @ZA00418 23970051 BZ CLOOP NEITHER,LOOP WAIT @ZA00418 24000051 BCR 1,CREG BOTH,ERROR-RETURN RC=8 @ZA00418 24030051 STCM INREG,HEX7,C3277CR3+1 ATTN ONLY-SET CCW=ADDR @ZA00418 24060051 STCM INREG,HEX8,C3277CR3+7 SET CCW=REPLY LENGTH @ZA00418 24090051 LA CCWREG,CONREAD GET ADDR OF READ CCW CHAIN @ZA00418 24120051 BAL RETREG,DUMPSIO GO DO I/O @ZA00418 24150051 TM CTFLG1,CTERROR WAS I/O ERROR @ZA00418 24180051 BCR 14,CREG YES,RETURN TO CALLER RC=8 @ZA00418 24210051 CLI RBDS3277,X'6E' WAS REPLY CANCEL INDICATOR @ZA00418 24240051 BE CONSOLE1 YES,GO RETRY @ZA00418 24270051 COK DS 0H @ZA00418 24300051 NI CTFLG1,HEXFF-CTERROR RESET ERROR FLAG @ZA00418 24330051 SR RETCODE,RETCODE SET RC=0 @ZA00418 24360051 BR CREG RETURN TO CALLER RC=0 @ZA00418 24390051 DS 0D @ZA00418 24420051 ERASECCW CCW ERASWRIT,C3277FM2,X'60',X'01' @ZA00418 24450051 CONCCW DS 0D @ZA00418 24470051 C3277CW1 CCW WRITECMD,C3277FM1,HEXA0,X'0A' @ZA00418 24490051 C3277CW2 CCW WRITECMD,CONCCW,HEXA0,X'01' @ZA00418 24510051 C3277CW3 CCW WRITECMD,C3277FM2,HEX20,X'04' @ZA00418 24530051 CONREAD DS 0D @ZA00418 24550051 C3277CR2 CCW READMOD,RBDS3277,HEXA0,X'06' @ZA00418 24570051 C3277CR3 CCW READMOD,CONREAD,HEX20,X'01' @ZA00418 24590051 ADDRCON DC F'272' @ZA00418 24690051 ADDRMASK DC X'C000' @ZA52618 24710000 C3277FM1 DC X'C311D7301D60' @ZA52618 24730000 DC C'AMD0' @ZA00418 24750051 C3277FM2 DC X'401D4013' @ZA00418 24780051 RBDS3277 DC 6X'00' @ZA00418 24810051 ERASWRIT EQU X'05' @ZA00418 24840051 WRITECMD EQU X'01' @ZA00418 24870051 READMOD EQU X'06' @ZA00418 24900051 REREPLY XC 0(0,INREG),0(INREG) @ZA00418 24930051 DS 0F @ZA00418 24960051 .ALTCON ANOP ALTERNATE CONSOLE ROUTINE 25050051 EJECT 25610051 .* MACRO SECTION 5 @ZA27964 25630051 ********************************************************************** 25830051 * * 25860051 * THE DUMP SIO ROUTINE. THIS ROUTINE HANDLES ALL SIO FOR THE DUMP * 25890051 * PROGRAM. THE ENTRY IS VIA THE DUMPSIO LABEL. * 25920051 * * 25950051 * THE PARAMETER REGISTERS ARE AS FOLLOWS: * 25980051 * IODEVREG...R10...DEVICE ADDRESS * 26010051 * CCWREG...R11...CHANNEL PROGRAM ADDRESS * 26040051 * BASEREG...R12...BASE REGISTER POINTING TO LOC X'7000' * 26070051 * RETREG...R13...RETURN REGISTER * 26100051 * * 26130051 * CTFLG1..IF CTERROR IS ONE SPECIFIES USER ERROR * 26160051 * EXISTS. THE ROUTINE WILL EXIT TO * 26190051 * THE ROUTINE IF AN ERROR OCCURS. * 26220051 * IF 0 REQUESTS LIMITED ERROR RECOVERY * 26250051 * IS TO BE PERFORMED BY THE SIO ROUTINE * 26280051 * * 26310051 ********************************************************************** 26340051 SPACE 26370051 TLOOPCSW DS 0H CSW STORED @ZA17663 26595051 TM CSW+4,X'92' ATTN,BUSY OR UNIT CHECK? @ZA17663 26598051 * (FOR EFFICIENCY TEST ALL 3 @ZA17663 26601051 * FIRST; RESULTS IN SHORTER @ZA17663 26604051 * PATH IN NORMAL CASE) @ZA17663 26607051 BZ TLOOP NO,LOOP TIL STATUS CLEAR @ZA17663 26610051 TM CSW+4,X'02' UNIT CHECK? @ZA17663 26613051 BO TLOOPUC YES, BRANCH @ZA17663 26616051 * ELSE ATTN AND/OR BUSY @ZA17663 26619051 CH IODEVREG,CONADDRX CONSOLE I/O? @ZA57190 26622000 BNE TLOOP NO, REAL BUSY @ZA17663 26625051 TM CTFLG2,CTALTCON ALTERNATE CONSOLE? @ZA17663 26628051 BZ TLOOP NO, REAL BUSY @ZA17663 26631051 B CATSEXIT YES, BAD ALTERNATE CONSOLE @ZA17663 26634051 TLOOPUC DS 0H UNIT CHECK @ZA17663 26637051 CLI 0(CCWREG),SENSECMD IS THIS A SENSE COMMAND ISSUED? 26640051 BE SIO YES, ERROR COND.,IGNORE TIO SINCE 26670051 * THE STATUS IS FROM THE CHANNEL 26680051 LA CCWREG,8(CCWREG) SET UP CCW FOR INT REQ 26690051 STCM CCWREG,HEX7,CSW+1 .SET UP CSW FOR INTV REQ 26700051 B CATSEXIT HANDLE CONDITION 26710051 EJECT @ZA56338 26710400 DUMPSIO DS 0H THE SIO SUBROUTINE FOR REAL DUMP 26710800 TLOOP DS 0H TIO LOOP TO CLEAR DEVICE STATUS 26711200 AIF ('&TYPE2' NE 'HI').FX13 @ZA56338 26711600 BAL TIOREG,TIOLOOP @ZA56338 26712000 B *+8 @ZA56338 26712400 B TLOOPCSW @ZA56338 26712800 BC 1,CATSEXIT @ZA56338 26713200 AGO .PFX13 @ZA57190 26713600 .FX13 ANOP @ZA57190 26714000 TIO 0(IODEVREG) CLEAR THE DEVICE TO INSURE IT IS 26714400 * AVAILABLE 26714800 BC 2,TLOOP WAIT UNTIL DEVICE IS FREE 26715200 BC 8,SIO IF AVAILABLE, ISSUE SIO 26715600 BC 4,TLOOPCSW BRANCH IF CSW STORED @ZA17663 26716000 * ELSE DEVICE NOT OPERATIONAL @ZA19025 26716400 XC CSW(4),CSW CLEAR SPURIOUS OLD CSW @ZA19025 26716800 B CATSEXIT ALLOW FOR RETURN TO CALLER @ZA19025 26717200 * OR ERROR MESSAGE @ZA19025 26717600 .PFX13 ANOP @ZA56338 26718000 SIO DS 0H START I/O ROUTINE 26720051 ST CCWREG,CAW SET THE CAW TO THE CHANNEL PGM 26730051 SIO 0(IODEVREG) PERFORM THE I/O OPERATION 26740051 BC 3,TLOOP IF BUSY, START I/O AGAIN @ZA56338 26750000 BC 8,TIO IF SIO WENT, BRANCH FOR TIO @ZA56338 26760000 TM CSW+4,HEX10 CHECK FOR BUSY CONDITION 26770051 BNZ TLOOP IF BUSY, START OVER 26780051 B CHECKERR ATTEMPT ERROR RECOVERY 26790051 TIO DS 0H LOOP TO WAIT UNTIL I/O IS COMPLETE 26800051 AIF ('&TYPE2' EQ 'HI').FX3 @ZA56338 26805000 TIO 0(IODEVREG) WAIT UNTIL OPERATION IS COMPLETED 26810051 BNL TIO IF NOT COMPLETE...CONTINUE WAIT LOOP 26820051 AGO .PFX3 @ZA57190 26821000 .FX3 ANOP @ZA57190 26822000 BAL TIOREG,TIOLOOP @ZA56338 26824300 B TLOOP @ZA56338 26826600 .PFX3 ANOP @ZA57190 26829000 CHECKERR DS 0H ERROR/NORMAL I/O CHECK 26830051 AIF ('&TYPE2' NE 'HI').FX23 @ZA56338 26870700 EASYERR DS 0H @ZA56338 26911400 TM CSW+5,CCC+CDC CHAN DATA/CTL CHK? @ZA27964 26952100 BNZ MCHKIOSK YES @ZA27964 26993051 .FX23 ANOP @ZA56338 27002000 TM CSW+5,X'3F' CATASTROPHIC CHAN ERROR? 27030051 BNZ CATSEXIT YES, CHANNEL IN TROUBLE: HANDLE IT 27040051 TM CSW+4,X'02' A UNIT CHECK CONDITION? 27050051 BNZ CATSEXIT IF UNIT CHECK, HANDLE ERROR COND 27060051 TM CSW+4,X'05' A DEVICE END CONDITION? 27070051 BZ TIO IF NOT DO TIO UNTIL DEV AVAIL 27080051 CLI 0(CCWREG),SENSECMD IS THIS A SENSE COMMAND ISSUED? 27090051 BCR 8,RETREG YES, DO NOT RESET ERB 27100051 XC CTERBDA(8),CTERBDA NORMAL RETURN, RESET ERR SW 27110051 BR RETREG RETURN TO CALLER 27120051 SPACE 27480051 ********************************************************************** 27510051 * * 27540051 * THIS ROUTINE HANDLES THE ERROR PROCESSING FOR THE SIO ROUTINE * 27570051 * * 27600051 ********************************************************************** 27630051 SPACE 27660051 CATSEXIT DS 0H THIS HANDLES THE I/O ERROR PROCESSING 27690051 * FIRST A CHECK IS MADE TO DETERMINE 27710051 * IF THE USER DESIRES TO PROCESS HIS 27730051 * OWN I/O ERRORS. 27750051 TM CTFLG1,CTERROR THE USER SETS CTERROR IF 27770051 * HE DESIRES TO HANDLE HIS OWN ERROR 27790051 * RECOVERY 27810051 BNO ERROUTE NO--PROVIDE MINIMUM ERROR 27830051 * PROCESSING AS A FUNCTION OF THE 27850051 * DEVICE 27870051 NI CTFLG1,HEX7F YES...THE USER DESIRES TO 27890051 * HANDLE HIS OWN I/O ERRORS 27910051 * INDICATE AN I/O ERROR OCCURRED AND GO 27930051 * TO THE USER'S I/O ERROR ROUTINE 27950051 BR RETREG EXIT TO USER 27970051 EJECT 27990051 .* MACRO SECTION 6 @ZA27964 28010051 ********************************************************************** 28170051 * * 28200051 * THIS IS THE DUMP ERROR ROUTINE. CONSOLE I/O ERRORS ARE * 28230051 * NOT HANDLED BY THIS ROUTINE. IF CTDEVICE IS 0 TAPE I/O ERRORS * 28260051 * WILL BE HANDLED IF CTDEVICE IS 1 DIRECT ACCESS I/O ERRORS WILL BE * 28290051 * HANDLED. NOTE: THE I/O ERROR RECOVERY IS A SUBSET OF THE * 28320051 * STANDARD I/O ERROR RECOVERY DUE TO SPACE RESTRICTIONS. * 28350051 * * 28380051 * REGISTER CONVENTIONS: R10-12 & 14 AS IN DUMPSIO * 28410051 * MSGREG...9...ERROR MSG * 28440051 * WORKREG3...7...RETURN SAVE REGISTER * 28470051 * WORKREG4...8...CCW SAVE REG * 28500051 * WORKREG1...5...RETRY WORK REGISTER * 28530051 * * 28560051 ********************************************************************** 28590051 SPACE 28620051 ERROUTE DS 0H I/O ERROR ENTRY POINT 28650051 LR WORKREG1,IODEVREG @ZA57190 28655000 SLL WORKREG1,4 @ZA57190 28660000 ST WORKREG1,WORK1 STORE I/O DEVICE @ZA57190 28665000 UNPK MSG03I+17(3),WORK1+2(2) UNPACK DEVICE TYPE @ZA24157 28670051 OI MSG03I+19,X'F0' CONVERT SIGN TO ZONE @ZA24157 28675051 UNPK MSG03I+26(9),CSW(5) UNPACK 1ST HALF OF CSW @ZA24157 28680051 UNPK MSG03I+34(9),CSW+4(5) UNPACK 2ND HALF @ZA24157 28685051 TR MSG03I+26(16),TABLE-240 TRAN TO PRINTABLE @ZA24157 28690051 MVI MSG03I+42,X'40' BLANK WORK BYTE OF MESSAGE @ZA24157 28695051 LA MSGREG,MSG03I SET UP CHAN ERR MSG IF ERROR 28700051 * IS PERMANENT 28710051 ICM MSGREG,HEX8,LMSG03I SET UP LENGTH OF ERR MSG 28740051 SPACE 28770051 ********************************************************************** 28800051 * * 28830051 * TAPE, PRINTER, AND D.A. COMMON I/O ERROR PROCESSING * 28860051 * * 28890051 ********************************************************************** 28920051 SPACE 28950051 AIF ('&TYPE2' EQ 'HI').LSE1 SKIP CHECK FOR CAT ERR IF HI 28980051 TM CSW+5,X'06' INTERFACE CONTROL CHECK(CSW BIT 46) 29010051 * OR CHANNEL CONTROL CHECK(CSW BIT 45)? 29020051 BNZ ERRMSG YES, SEVERE ERROR OUTPUT ERR MSG 29030051 .LSE1 ANOP 29040051 TM CSW+4,X'02' UNIT CHECK (CSW BIT 38)? 29050051 BNO ERRMSG NO, EXIT FOR ERROR MSG REGARDLESS 29060051 * OF THE ERROR CONDITION 29070051 LM WORKREG1,WORKREG2,CSW SAVE CSW FOR USE BY 29080051 * INTERVENTION REQUIRED AND BUS CHECK 29090051 * RECOVERY CONDITIONS (TAPE ONLY) 29100051 ICM CCWREG,HEX7,CSW+1 .RESTORE THE CCW 29110051 DATACHAN DS 0H SET UP IF DATA CHAINING 29120051 SH CCWREG,H8 BACK UP TO FAILING CCW 29130051 AIF ('&TYPE2' EQ 'LO').SKDATAZ IF LO NO DATA CHAIN 29140051 LA WORKREG4,WRITECCW .IS THIS A DATA CHAIN TAPE CCW 29150051 CR CCWREG,WORKREG4 CURRENT CCW DATA CHAIN? 29160051 BE DATACHAN YES, BACK UP TO START 29170051 .SKDATAZ ANOP RESUME ERROR RECOVERY NORM 29180051 OC CSW+1(3),CSW+1 DETERMINE IF CSW CCW=0? 29190051 BNZ CCWNOT0 IF NOT,IGNORE 29200051 L CCWREG,CAW ZERO, SET UP TO CAW @ZA27964 29210051 CCWNOT0 DS 0H NOW PROPER CCW SET UP 29220051 SPACE 29310051 ********************************************************************** 29340051 * * 29370051 * NOTE: THE REMAINDER OF ERROR HANDLING ASSUMES THE USER RETURN * 29400051 * REGISTER IS IN WORKREG3 AND THE CHANNEL PROGRAM ADDRESS * 29430051 * IS IN WORKREG4. THESE REGISTERS MUST NOT BE DESTROYED * 29460051 * * 29490051 ********************************************************************** 29520051 SPACE 29550051 LR WORKREG4,CCWREG SAVE THE CHANNEL PROGRAM @ZA27964 29580051 LR WORKREG3,RETREG SAVE THE USER RETURN REG @ZA27964 29610051 LA CCWREG,TAPESENS SET UP TO ISSUE A SENSE COMMAND 29680051 BAL RETREG,DUMPSIO GO ISSUE THE SENSE 29730051 LR RETREG,WORKREG3 RESTORE RETURN REG OF USER 29780051 * NOTE THAT WORKREG3 STILL HAS 30090051 * THE RETURN REG VALUE. THERE IS 30120051 * NO ERROR CHECKING DONE FOR THE 30150051 * SENSE OPERATION SINCE ONLY A 30180051 * CHANNEL ERROR WILL PREVENT THE 30210051 * OPERATION AND WILL NOT TERMINATE 30240051 * PROCESSING PRIOR TO THIS POINT 30270051 LR CCWREG,WORKREG4 RESTORE USER CHANNEL PGM 30300051 * THIS IS DONE FOR RETRY OPERATIONS 30320051 STM WORKREG1,WORKREG2,CSW RESTORE THE CSW 30340051 AIF ('&IPL2'(1,1) EQ 'T').LSE2 IF TAPE IPL EQU CHK LATER 30360051 TM SENSE03,HEX10 EQUIPMENT CHECK COND? 30380051 AIF ('&OUTPUT2'(1,1) NE 'P').NOTPTR @Z40MI3F 30422051 BNO DAERROR DISK ERROR? @Z40MI3F 30424051 TM CT3800,1 PRINTER TYPE? @Z40MI3F 30426051 BNO ERRMSG PRINT ERROR MESSAGE @Z40MI3F 30428051 TM SENSAREA+1,HEX20 ERROR LOG FULL? @Z40MI3F 30430051 BNO ERRMSG NO, PRINT ERROR MESSAGE @Z40MI3F 30432051 LA CCWREG,RELCCW SENSE ERROR LOG CCW @Z40MI3F 30434051 OI CTFLG1,CTERROR PREVENT RECURSION @Z40MI3F 30436051 BAL RETREG,DUMPSIO SENSE ERROR LOG @Z40MI3F 30438051 NI CTFLG1,HEX7F RESET ERROR FLAG @Z40MI3F 30440051 LR RETREG,WORKREG3 RESTORE RETRY REG @Z40MI3F 30442051 LR CCWREG,WORKREG4 RESTORE CCW REG @Z40MI3F 30444051 B PTRETRYA @Z40MI3F 30446051 .NOTPTR AIF ('&OUTPUT2'(1,1) EQ 'P').LSE2 @Z40MI3F 30448051 BO ERRMSG YES, EXIT TO MSG 30450051 .LSE2 ANOP SET UP TAPE ERROR RECOVERY 30470051 AIF ('&IPL2'(1,1) EQ 'T').SKIPDA NO DA RETRY CODE FOR TAPE 30490051 DAERROR TM CTFLG1,CTDEVICE DA I/O ERROR? @Z40MI3F 30510051 BO DARETRY YES, HANDLE THE D.A. ERROR 30530051 .SKIPDA ANOP TAPE RETRY CODE IS HERE 30550051 AIF ('&OUTPUT2'(1,1) EQ 'P').PTERR PTR & TAPE INCOMPATIBLE 30570051 L ERROREG,CTERBTPE OBTAIN THE TAPE ERB 30590051 TM SENSE02,HEX20 BUS OUT CHECK COND? 30610051 BO BUSCHK YES, GO RETRY BUS CHECK 30630051 TM SENSE01,HEX40 INTERVENTION REQUIRED? 30650051 BO INTVR YES, GO OUTPUT INTV MSG 30670051 CMDREJ DS 0H PROCESS COMMAND REJECT COND 30690051 TM SENSE00,HEX80 COMMAND REJECT? 30710051 BO FPTAPECK YES, EXIT TO F P 30730051 TM SENSE05,X'04' OVERRUN CONDITION? 30750051 BO REPOSTPE YES, RETRY TO CORRECT 30770051 AIF ('&TYPE2' EQ 'HI').LSE4 SET UP FOR DATA CHK IF HI 30790051 TM SENSE14,X'08' LOAD POINT? 30810051 BO ERRMSG YES, PRINT MSG THEN EXIT 30830051 .LSE4 ANOP DATA CHECK TEST FOR HIGH 30850051 TM SENSE04,X'08' DATA CHECK 30870051 BNO FPTAPECK NO, CHECK FOR F P TAPE 30890051 CLI 0(CCWREG),WRITETPE A WRITE OPERATION? 30910051 BNE RETRY15 NO, RETRY A MAX OF 15 TIMES 30930051 STCM CCWREG,HEX7,MODETIC+1 SET UP RESUME CCW 30950051 LA CCWREG,TAPERROR PICK UP THE CHANNEL PGM 30970051 RETRY15 DS 0H THIS SETS UP A 15 TIME RETRY 30990051 LTR ERROREG,ERROREG ERROR HANDLING ALREADY 31010051 * IN PROGRESS? 31030051 BNZ COMMONER YES, GO RETRY THE OPERATION 31050051 AIF ('&TYPE2' EQ 'HI').LSE5 SET UP FOR DATA CHECK IF HI 31070051 MVC CTERBTPE(4),DATCKTPE OBTAIN THE TAPE DATA CHECK 31090051 * RETRY COUNT 31110051 AGO .LSE6 SKIP AROUND HI SET UP OF ERB 31130051 .LSE5 ANOP HI SET UP OF ERB 31150051 MVI CTERBTPE+3,HEX10 SET UP CTERBTPE WITH ERROR RETRY CT 31170051 .LSE6 ANOP RESUME COMMON ERB RETRY CODE 31190051 COMMONER DS 0H COMMON RETRY CODE 31210051 SR WORKREG1,WORKREG1 COUNTER REGISTER 31230051 IC WORKREG1,ERBRETRY OBTAIN CURRENT RETRY CT 31250051 BCT WORKREG1,ERBPRIME DECREMENT BY ONE TIME 31270051 B ERRMSG IF ALL DONE, EXIT TO MSG ROUTINE 31290051 SPACE 1 @ZA27964 31310051 FPTAPECK DS 0H 31330051 TM SENSE16,X'02' IS IT FP TAPE 31350051 BNO ERRMSG NO EXIT ON ALL OTHER ERRORS 31370051 ST CCWREG,LOWCORE1 STORE CURR CCW 31390051 LA CCWREG,RWULDCMD GET REWIND UNLOAD 31410051 LH IODEVREG,CTOUTAD LOAD TAPE ADDR 31430051 OI CTFLG1,CTERROR SET UP FOR OWN E R 31450051 BAL RETREG,DUMPSIO ISSUE REWIND UNLOAD 31470051 LR RETREG,WORKREG3 RESTORE RETURN ADDRESS @ZA56338 31480000 SR INREG,INREG ZERO READ REG 31490051 LA OUTREG,MSG19A F P MSG 31510051 ICM OUTREG,HEX8,LMSG19A LOAD LENGTH 31530051 BAL CREG,CONSOLE GO ISSUE MSG 31550051 LTR RETCODE,RETCODE WAS THERE AN ERROR 31570051 BNZ ERRMSG EXIT ON ERROR 31590051 OI CTLOWFLG,CTFP SET UP FOR FP ENTRY TO LBL CHK 31610051 FPTIOLP DS 0H 31630051 B LBLALT GO CHECK FOR LBL TAPE 31710051 SPACE 4 @ZA56338 31720000 AIF ('&TYPE2' NE 'HI').DAE021 @ZA27964 31730051 MCHKIOSK LA CCWREG,TAPEREP SET UP TO REPOSITION TAPE @ZA27964 31740051 OI CTFLG2,CTWKDONE STOP WRITING THE WORK FILE @ZA27964 31750051 * REENTER MAIN LOOP SO THE REPOSITION 31760051 * WILL LOOK LIKE SUCCESSFUL WRITING OF 31770051 * THE FRAME AND THINGS WILL PROGRESS 31780051 * NORMALLY TO THE NEXT FRAME. @ZA27964 31790051 .DAE021 ANOP @ZA27964 31800051 ERBPRIME DS 0H HANDLE PRIMARY CTR 31890051 STC WORKREG1,ERBRETRY .SAVE RETRY CTR. NOTE: 32370051 * THIS LIMITS THE TOTAL NUMBER OF 32400051 * RETRIES TO 256 32430051 AIF ('&TYPE2' EQ 'HI').LSE7 SET UP FOR NO PRIME CTR IF HI 32460051 IC WORKREG1,ERBCTRP PRIMARY RETRY CTR 32490051 BCT WORKREG1,ERBSIO DECREMENT BY ONE 32510051 B ERRMSG ALL FINISHED. ERROR MSG 32530051 ERBSIO DS 0H THIS IS THE SIO HANDLER 32550051 * FOR ERROR RETRIES 32570051 STC WORKREG1,ERBCTRP UPDATE PRIMARY RETRY CTR 32590051 .LSE7 ANOP RETURN TO DUMPSIO 32610051 B DUMPSIO ISSUE RETRY OPERATION 32630051 SPACE 32730051 ********************************************************************** 32760051 * * 32790051 * THIS CODE RETRIES THE INTERVENTION REQUIRED CONDITION * 32820051 * * 32850051 ********************************************************************** 32880051 SPACE 32910051 INTVR DS 0H INTERVENTION REQUIRED CODE 32940051 TM CSW+4,X'04' DEVICE END CONDITION? 32960051 BNO INTVR1 DETERMINE DEVICE STATE 32980051 CLI 0(CCWREG),REWINDUD WAS IT A REWIND-UNLOAD? 33000051 BCR 8,RETREG YES, IGNORE COMMAND 33020051 B CMDREJ NO, IGNORE CONDITION 33040051 INTVR1 DS 0H CHECK DEVICE STATUS 33060051 TM SENSE12,HEX20 TU COND? 33080051 BNO ERRMSG NO, SET UP ERROR MSG 33100051 AIF ('&IPL2'(1,1) EQ 'D').LC1 IF DA IPL SKIP TAPE IPL CHK 33120051 CH IODEVREG,CTINADDR IS THIS THE IPL ADDR 33140000 BE IPLINTA YES,HANDLE FOR IPL DEV MSG @ZA24157 33160000 .LC1 ANOP RESUME INT REQ TEST FOR DEFAULT 33180051 MVC MSG14I+13(3),CTEBCOPR MOVE IN EBCDIC DEV ADDR 33200051 INTVR2 DS 0H GO TO CONSOLE RTN 33220051 LA OUTREG,MSG14I SET UP FOR INTV REQ MSG 33240051 ICM OUTREG,HEX8,LMSG14I OBTAIN MSG LENGTH 33260051 INTVR2A DS 0H SET UP FOR INTV MSG 33280051 ST IODEVREG,TEMPSAVE .SAVE DEVICE ADDRESS 33300051 SR INREG,INREG PREPARE TO ISSUE INTV REQ MSG 33320051 BAL CREG,CONSOLE OUTPUT MSG 33340051 MVI LMSG14I,HEX10 RESTORE ORGINAL MSG LENGTH 33360051 * THIS IS DONE FOR IPL DEV MSG WHICH 33380051 * IS HANDLED IN A SPECIAL WAY IN 33400051 * ORDER TO CONSERVE STORAGE 33420051 L IODEVREG,TEMPSAVE .RESTORE DEVICE ADDR 33440051 LTR RETCODE,RETCODE ERROR ON OUTPUT? 33460051 BZ INTVR3 YES, WAIT STATE 33480051 INTVWAIT DS 0H 33500051 MVI CTWAIT,X'0E' SET UP WAIT STATE CODE 33520051 B TAPESW EXIT WITH CODE 33540051 INTVR3 DS 0H RETRY ON INTV REQ 33560051 LR CCWREG,WORKREG4 RESTORE USER CHANNEL PGM 33580051 LR RETREG,WORKREG3 RESTORE RETURN REG 33600051 INTLOOP DS 0H WAIT FOR INTVR DEVICE TO BECOME 33620051 AIF ('&TYPE2' NE 'HI').FX15 @ZA56338 33622500 BAL TIOREG,TIOLOOP @ZA56338 33625000 B *+8 @ZA56338 33627500 B INTLOOP @ZA56338 33630000 BC 1,ERRMSG @ZA56338 33632500 AGO .PFX15 @ZA56338 33635000 .FX15 ANOP @ZA57190 33637600 TIO 0(IODEVREG) READY FOR I/O 33640051 BC 7,INTLOOP LOOP UNTIL READY 33660051 .PFX15 ANOP @ZA56338 33670000 B DUMPSIO YES, VERIFY THE LABEL AS NL 33680051 BUSCHK DS 0H HERE FOR BUS OUT CHECK 33700051 TM CSW+4,X'04' DEVICE END COND? 33720051 BNO OVERUNCK NO, RETRY 5 TIMES MAX 33740051 REPOSTPE DS 0H SET UP TO REPOSITION THE TAPE 33760051 STCM CCWREG,HEX7,BUSTIC+1 YES SET UP TO REPOSITION 33780051 * THE TAPE THEN RETRY THE OPERATION 33800051 LA CCWREG,TAPEBUS RESTART THE CCW COMMAND 33820051 OVERUNCK DS 0H OVERRUN CONDITION 33840051 LTR ERROREG,ERROREG ERROR RECOVERY IN OPER? 33860051 BNZ COMMONER YES, RETRY OPERATION 33880051 AIF ('&TYPE2' EQ 'HI').LSE8 FOR HI SKIP OVER RETRY CTR 33900051 MVC CTERBTPE(4),OVERUNTP RETRY UP TO FIVE TIMES 33920051 AGO .LSE9 PREPARE FOR RETRY OPERATION 33940051 .LSE8 ANOP HI RETRY CTR FOR OVERRUN 33960051 MVI CTERBTPE+3,X'05' SET UP HI OVERRUN CTR 33980051 .LSE9 ANOP DECREMENT RETRY COUNTER 34000051 B COMMONER RETRY OPERATION 34020051 AIF ('&OUTPUT2'(1,1) EQ 'T').IPLIA SKIP PTR CODE @ZA24157 34040051 .PTERR ANOP PRINTER ERROR RECOVERY CODE 34060051 SPACE 34650051 ********************************************************************** 34680051 * * 34710051 * THIS SECTION WILL PROVIDE PRINTER I/O ERRROR RECOVERY ON ALL PTRS * 34740051 * * 34770051 ********************************************************************** 34800051 SPACE 34830051 TM SENSE04,X'1E' A PARITY ERROR CONDITION OR 34860051 * A CONDITION WHICH SHOULD NOT OCCUR 34880051 BNZ ERRMSG IF THIS EXITS PROVIDE ERR MSG 34900051 TM SENSE01,HEX40 INTERVENTION REQUIRED COND 34920051 BO INTVR HANDLE WITH ACTION AND MSG 34940051 TM SENSE02,HEX20 BUS OUT CONDITION 34960051 BO PTRETRYA YES MSG AND RETRY 34980051 TM SENSE01,X'01' CHANNEL 9 CONDITION? 35000051 BCR 1,RETREG YES, RESTART I/O, IGNORE ERROR 35020051 TM CTLOWFLG,CTINIT INITIALIZATION STAGE? @Z40MI3F 35106051 BNO PTRETRYA RETRY PRINTER CCW @Z40MI3F 35112051 NI CT3800,0 TURN OFF 3800 SWITCH @Z40MI3F 35118051 BR RETREG RETURN FOR TITLE @Z40MI3F 35124051 PTRETRYA DS 0H PRINTER RETRY OPERATION 35130051 L ERROREG,CTERBPTR OBTAIN PTR RETRY BLOCK 35180051 LTR ERROREG,ERROREG RETRY IN PROCESS? 35230051 BNZ ERRMSG YES, EXIT WITH MSG AND RETRY ACTION 35280051 MVC CTERBPTR(4),PTRCHK SET UP PRT RETRY ACTION 35330051 B DUMPSIO RETRY THE I/O OPERATION ONCE 35380051 INTVR DS 0H PRINTER INTERVENTION CODE 35430051 MVC MSG14I+13(3),CTEBCOPR MOVE IN EBCDIC DEV ADDR 35480051 INTVR2 DS 0H GO TO CONSOLE RTN 35530051 ST IODEVREG,TEMPSAVE .SAVE DEVICE REGISTER 35580051 SR INREG,INREG PREPARE TO ISSUE INTV REQ MSG 35630051 LA OUTREG,MSG14I SET UP FOR INTV REQ MSG 35680051 ICM OUTREG,HEX8,LMSG14I OBTAIN MSG LENGTH 35730051 BAL CREG,CONSOLE OUTPUT MSG 35780051 MVI LMSG14I,HEX10 RESET MSG LENGTH. THIS IS DONE 35830051 * FOR COMMON MSG USUAGE 35880051 * FOR IPL DEV MSG 35930051 LTR RETCODE,RETCODE ERROR ON OUTPUT? 35980051 BZ INTVR3 NO, SET UP FOR RETRY 36030051 MVI CTWAIT,X'04' MOVE IN I/O ERR WAIT CODE 36080051 B WAITSTAT SET WAIT STATE PSW 36130051 INTVR3 DS 0H RSEUME INTERVENTION 36180051 L IODEVREG,TEMPSAVE .RESTORE DEVICE REGISTER 36230051 LR CCWREG,WORKREG4 RESTORE USER CHANNEL PGM 36280051 LR RETREG,WORKREG3 RESTORE RETURN REG 36330051 INTLOOP DS 0H WAIT FOR INTVR DEVICE TO BECOME 36380051 AIF ('&TYPE2' NE 'HI').FX17 @ZA56338 36386200 BAL TIOREG,TIOLOOP @ZA56338 36392400 B *+8 @ZA56338 36398600 B INTLOOP @ZA56338 36404800 BC 1,ERRMSG @ZA56338 36411000 AGO .PFX17 @ZA56338 36417200 .FX17 ANOP @ZA57190 36424000 TIO 0(IODEVREG) READY FOR I/O 36430051 BC 7,INTLOOP LOOP UNTIL READY 36480051 .PFX17 ANOP @ZA56338 36505000 B DUMPSIO NO, RETRY I/O WHEN DEVICE READY 36530051 .IPLIA ANOP TAPE RETRY CODE @ZA24157 36580051 IPLINTA DS 0H TAPE IPL INTERVENTION CODE @ZA24157 36630051 MVC MSG14I+13(3),IPLMSG SET UP IPL DEVICE MESSAGE @ZA24157 36680051 MVI LMSG14I,HEX14 SET PROPER MESSAGE LENGTH @ZA24157 36730051 B INTVR2 RETRY THE I/O OPERATION @ZA24157 36780051 AIF ('&IPL2'(1,1) EQ 'T').GKM IF IPL FROM TAPE, FORGET DA 36830051 AIF ('&TYPE2' EQ 'LO').CLEAN NO PAGE DUMP FOR LO DUMP 36880051 EJECT 36930051 *************************************************************@ZA17663* 36980051 * @ZA17663* 37030051 * THIS IS THE PROCESSING WHICH FOLLOWS THE RETURN FROM @ZA17663* 37080051 * THE CALL TO DUMPSIO TO LOAD THE PRECURSOR. THIS @ZA17663* 37130051 * CODE IS SEPARATED FROM THE CALLING SEQUENCE FOR LOADING @ZA17663* 37180051 * THE PRECURSOR BECAUSE OF THE OF THE OVERLAY SCHEME WHICH @ZA27964* 37230051 * BRING THE PRECURSOR IN OVER THE LAST HALF OF THIS MODULE. @ZA27964* 37260051 * THIS CODE CHECKS TO BE SURE THAT THE PRECURSOR @ZA17663* 37330051 * WAS OBTAINED SUCCESSFULLY THEN PASSES CONTROL @ZA17663* 37380051 * TO IT IN R15. @ZA17663* 37750051 * @ZA17663* 37751051 *************************************************************@ZA17663* 37752051 SPACE 1 @ZA17663 37753051 GETPROIO DS 0H POST DUMPSIO GETPRO PROCESSING 37754051 * @ZA17663 37755051 TM CTFLG1,CTERROR DID AN I/O ERROR OCCUR? 38490051 TEST DS 0H 38510051 BO GOTOPRO NO, GO TO AMDSAPRO 38530051 LA MSGREG,MSG13I SET UP FOR I/O ERR LOADING PRECURSOR 38550051 ICM MSGREG,HEX8,LMSG13I SET LENGTH OF MSG 38570051 MVI CTWAIT,PROLDERR SET WAIT CODE 38590051 B ERRMSG1 EXIT WITH MSG AND CODE 38610051 GOTOPRO DS 0H PRECURSOR EXIT 38630051 XC IOINTDEV(2),IOINTDEV ZERO TO SHOW HSR ENTRY @ZA56338 38650000 STM SAVREG,RETCODE,GPRLOC SAVE REGS 38670051 NI CTFLG1,HEXFF-CTERROR TURN OFF NO ERR REC SW 38690051 PROEP EQU CCT+X'830' PRO IS READ IN OVER LAST 2K @ZA27964 38710051 BAL CREG,PROEP CALL PRECURSOR @ZA27964 38720051 LM SAVREG,CREG,GPRLOC RELOAD 1-14 38770051 LTR RETCODE,RETCODE ERROR OCCUR 38790051 BZ PGEISIN NO GO TO PGE 38810051 LA MSGREG,MSG26I SET ERROR LOADING PGE MSG 38830051 ICM MSGREG,HEX8,LMSG26I GET MSG LENGTH 38850051 B ERRMSG1 GO ISSUE MSG AND WAIT 38870051 .GKM ANOP 38890051 PGEISIN DS 0H 38910051 LA RETREG,DUMPTITL SET UP REG 13 FOR PGE 38930051 USING DUMPTITL,RETREG @ZA08992 38950051 LA RETCODE,CCT+X'1000' @ZA08992 38970051 DROP RETREG @ZA08992 38990051 BR RETCODE EXIT TO PGE 39010051 .CLEAN ANOP CLEAN-UP CODE 39030051 AIF ('&TYPE2' EQ 'HI').ERMSG FOR TYPE HI SKIP CLEANUP 39050051 CLEANUP DS 0H PREPARE TO UNLOAD THE TAPE AND EXIT 39070051 MVI CTWAIT,X'00' SET UP ZERO RETURN CODE 39090051 B TAPESW REWIND THE TAPE 39110051 .* MACRO SECTION 8 @ZA27964 39130051 .ERMSG ANOP SET UP ERROR MSG PROCESSING 39150051 EJECT 39170051 ********************************************************************** 39510051 * * 39540051 * THIS ROUTINE OUTPUTS THE ERROR MESSAGES AND PLACES THE FUNCTION * 39570051 * INTO A WAIT STATE IF REQUIRED. NORMAL PROCESSING ENDS HERE ALSO * 39600051 * * 39630051 ********************************************************************** 39660051 SPACE 39690051 ERRMSG DS 0H WAIT CODE I/O ERROR MSG 39720051 TM CTFLG1,CTERREC USER CTL ON CAT ERROR ? 39740051 BNO NOERREC NO ERROR REC 39760051 NI CTFLG1,HEXFF-CTERREC INDICATE ERROR 39780051 BR RETREG RETURN TO CALLER 39800051 NOERREC DS 0H 39820051 MVI CTWAIT,X'03' SET UP A 4 WAIT STATE CODE 39840051 ERRMSG1 DS 0H ERROR MSG IS IN REGISTER 9 39860051 SR INREG,INREG ZERO READ INPUT REG 39880051 LR OUTREG,MSGREG SET UP OUTPUT MSG 39900051 BAL CREG,CONSOLE GO OUTPUT THE MSG 39920051 TM CTLOWFLG,CTINIT IS THIS INITIALIZATION 39940051 BNZ CANCEL YES, REISSUE TAPE= MSG 39960051 STC RETCODE,LOCORE14 SAVE RET CODE TO PROCESS AFTER 39980051 * THE TAPE HAS BEEN UNLOADED 40000051 TAPESW DS 0H SET IF TAPE IS TO BE UNLOADED 40020051 B FLGCHECK INITIALLY NO. THIS IS CHANGED 40040051 * TO A NOP 40060051 AIF ('&OUTPUT2'(1,1) EQ 'P').NOUNLD1 SKIP TPE CDE FOR PTR 40080051 LH IODEVREG,CTOUTAD OBTAIN THE TAPE OUTPUT ADDR 40100051 LA CCWREG,WTMCMDF SET UP THE REWIND-UNLOAD COMMD 40120051 OI CTFLG1,CTERROR SET FLG TO PREVENT RECURSIVE 40140051 * ERROR RECOVERY. THIS ROUTINE WILL 40160051 * IGNORE ERRORS WHEN REWINDING THE TAPE 40180051 BAL RETREG,DUMPSIO GO ISSUE REWIND 40200051 NI CTFLG1,HEX3F RESET ERROR FLAG 40220051 MVI TAPESW+1,HEXF0 RESTORE TAPESW INSTRUCTION 40240051 * IF WE RECYCLE THROUGH THE CODE 40260051 * ONCE AGAIN 40280051 .NOUNLD1 ANOP TERMINATION CK CODE 40300051 FLGCHECK DS 0H CHECK IF PGM ENDS OR CONTINUES 40320051 CLI LOCORE14,X'00' FAILURE OUTPUTTING 40340051 * THE CONSOLE ERROR MESSAGE? 40360051 ENDUP1 DS 0H ENDING PROCESSING 40380051 BE TESTWAIT NO, GO OBTAIN TAPE ADDR AND START 40400051 * OVER FROM THE TOP. NOTE: THIS 40770051 * INSTRUCTION IS MODIFIED FOR FINAL 40800051 * CLEAN-UP PROCESSING TO IGNORE A 40830051 * CONSOLE ERROR 40860051 ENDUPA DS 0H 40890051 TM CTFLG1,CTDEFO HAVE WE USED THE DEFAULT DEVICE? 40920051 BNO CANCEL NO, GO RETRY WITH ANOTHER DEVICE 40940051 MVI CTWAIT,X'03' YES, SET UP I/O ERROR CODE 40960051 TESTWAIT DS 0H WAIT STATE INDICATED CHECK 40980051 CLI CTWAIT,X'00' A ZERO WAIT STATE CODE? 41000051 ENDUP2 BE CANCEL YES, RESTART PROCESSING 41020051 * NOTE: CLEAN-UP PROCESSING WILL 41100051 * MODIFY THIS INSTRUCTION TO A NOP 41130051 * FOR NORMAL TERMINATION 41160051 AIF ('&IPL2'(1,1) EQ 'D').NOUNLD2 AGAIN, TPE NOT NEED 41190051 CLC CTOUTAD(2),CTINADDR UNLOADED IPL TAPE YET? 41220051 BE WAITSTAT YES, GO LOAD WAIT PSW 41240051 MVC CTOUTAD(2),CTINADDR NO, RECYCLE THROUGH REWIND 41260051 * UNLOAD CODE TO DISMOUNT THE TAPE 41280051 B TAPESW+4 UNLOAD THE TAPE (SKIP PROCESSING 41300051 * AT TAPESW SINCE THE NOP WAS 41320051 * CHANGED THE FIRST TIME THROUGH 41340051 .NOUNLD2 ANOP WAIT STATE COND 41360051 SPACE 41460051 ********************************************************************** 41490051 * * 41520051 * THIS CODE LOADS A WAIT STATE PSW FOR PROGRAM TERMINATION * 41550051 * * 41580051 ********************************************************************** 41610051 SPACE 41640051 WAITSTAT DS 0H WAIT STATE CODE 41670051 AIF ('&OUTPUT2'(1,1) NE 'P').NOTPTR2 @Z40MI3F 41674051 LH IODEVREG,CTOUTAD POINT TO PRINTER @Z40MI3F 41678051 LA CCWREG,PTRCCW1 SKIP TO CHANNEL 1 CCW @Z40MI3F 41682051 MVI PTRCCW1,HEX8B ENSURE IMMEDIATE COMMAND @Z40MI3F 41686051 BAL RETREG,DUMPSIO ISSUE START I/O @Z40MI3F 41690051 .NOTPTR2 ANOP @Z40MI3F 41694051 MVC HALTPSW+7(1),CTWAIT SET UP CODE 41700051 LPSW HALTPSW WAIT 41720051 .* MACRO SECTION 9 @ZA27964 41740051 AIF ('&OUTPUT2'(1,1) EQ 'P').OUTCCWS FOR PTR SKIP LBL CHKS 41760051 EJECT 41780051 ********************************************************************** 41820051 * * 41850051 * THIS CODE PROVIDES LABEL VERIFICATION FOR TAPES. * 41880051 * IF A TAPE IS STANDARD LABELLED, THE PROGRAM REJECTS IT AND * 41910051 * REQUESTS A MOUNT OF A NON-LABELLED TAPE. * 41940051 * * 41970051 ********************************************************************** 42000051 SPACE 42030051 LBLCHECK DS 0H THE IPL ADDR IS COMPARED TO THE 42060051 * OUTPUT ADDR, AND IF EQUAL THIS IS A 42080051 * NL TAPE AND THE TAPE 42100051 * LABEL VERIFICATION IS BYPASSED 42120051 LBLCK1A DS 0H SET UP IF EOR CONDITION 42140051 ST RETREG,SAVERET1 SAVE RETREG ACROSS DUMPSIO 42160051 LBLALT DS 0H 42180051 MVI TAPESW+1,NOP SET TAPE SW TO UNLOAD TAPE 42200051 LH IODEVREG,CTOUTAD OBTAIN THE OUTPUT TAPE ADDR 42220051 LA CCWREG,RWCMD ISSUE REWIND FIRST TO POSITON TAPE 42240051 BAL RETREG,DUMPSIO ISSUE COMMAND 42260051 LA CCWREG,TAPECCW SET UP TO RESTORE MODETIC 42280051 STCM CCWREG,HEX7,MODETIC+1 RESTORE TO ORGINAL COND 42300051 LA CCWREG,MODE7TRK SET UP MODESET FOR TAPE 42320051 READTAPE DS 0H READ THE VOL LABEL ON TAPE 42340051 BAL RETREG,DUMPSIO GO ISSUE THE MODESET FOR THE TAPE 42360051 MVI LBLADDR,0 INVALIDATE LABEL AREA 42380051 LA CCWREG,VOLABEL ISSUE READ FOR VOLUME LABEL 42400051 OI CTFLG1,CTERROR SET UP TO IGNORE ERROR ON READ 42420051 BAL RETREG,DUMPSIO THIS HANDLES A UNIT CHECK CAUSED 42440051 * BY A TAPE MARK FOLLOWING A VOL LABEL 42460051 TM CTFLG1,CTERROR DID AN ERROR OCCUR? 42480051 BNO ERRMSGL YES, IGNORE AND GET ANOTHER TAPE 42500051 NI CTFLG1,HEXFF-CTERROR RESET ERROR SWITCH 42520051 CLC LBLADDR(4),VOL1 DETERMINE IF A STANDARD LBL TAPE 42540051 BE ERRMSGL YES, PRINT OUT AMD010I MSG AND UNLOAD 42560051 * THE TAPE 42580051 CLC LBLADDR(4),ASCIILAB IS THIS AN ASCII LBL TAPE? 42600051 BNE LBLCOND NO, GET DUMP TITLE; TAPE IS NL 42620051 ERRMSGL DS 0H ISSUE A REWIND UNLOAD FOR THE TAPE 42640051 * THIS WILL ALLOW THE OPERATOR TO MOUNT 42660051 * ANOTHER TAPE ON THE SAME UNIT 42680051 LA CCWREG,RWULDCMD SET UP FOR REWIND-UNLOAD 42700051 BAL RETREG,DUMPSIO GO ISSUE THE COMMAND 42720051 LA OUTREG,LBLERR1 SET UP LBL ERR MSG IF THE TAPE IS 42740051 * TO BE REJECTED 42760051 ICM OUTREG,HEX8,LMSG21I SET UP FOR LBL ERR MSG 42780051 XC LBLADDR(4),LBLADDR CLEAR LABEL INPUT AREA @ZA13019 42800051 BAL CREG,CONSOLE ISSUE MSG 42820051 L CCWREG,LOWCORE1 OBTAIN CCW 42840051 LTR RETCODE,RETCODE DID ERROR OCCUR 42860051 BNZ ENDUPA GO LOAD WAIT STATE 42880051 CONEXIST DS 0H 42900051 TM CTFLG1,CTMORTPE IS ENTRY FROM EOR 42920051 BO NRMLRTN YES, NORMAL RETURN 42940051 TM CTLOWFLG,CTFP IS THIS FP ENTRY . 42960051 BO FPTIOLP ENTER INTV REQ LOOP 42980051 NRMLRTN DS 0H 43000051 LA RETCODE,4 SET UP ERROR RETURN CODE 43020051 L RETREG,SAVERET1 RESTORE RETREG 43040051 BR RETREG RETURN TO CALLER 43060051 LBLCOND DS 0H 43080051 LA CCWREG,WRITRWD ISSUE WRITE REWIND 43100051 BAL RETREG,DUMPSIO GO ISSUE COMMAND 43120051 NI CTLOWFLG,HEXFF-CTFP TURN OFF FP ENTRY BIT 43140051 L RETREG,SAVERET1 RESTORE RETREG 43160051 L CCWREG,LOWCORE1 RESTORE CCW 43180051 SR RETCODE,RETCODE SET 0 RETURN CODE 43200051 BR RETREG IF YES RETURN 43220051 SPACE 43830051 ********************************************************************** 43860051 * * 43890051 * THIS SECTION OF CODE WILL OBTAIN AN ADDITIONAL TAPE VOLUME * 43920051 * * 43950051 ********************************************************************** 43980051 SPACE 44010051 MORTAPE DS 0H FOR END OF REEL CONDITION 44040051 ST CREG,SAVERET2 SAVE RETREG ACROSS DUMPSIO 44080051 OI CTFLG1,CTERROR+CTMORTPE .SET UP MORE TAPE COND 44120051 LA CCWREG,WTMCMD SET UP FOR REWIND-UNLOAD COMMAND 44160051 BAL RETREG,DUMPSIO ISSUE COMMAND 44200051 LA CCWREG,RWULDCMD WTM WILL BREAK CHAIN-ISSUE REWIND-ULD 44240051 BAL RETREG,DUMPSIO ISSUE REWIND UNLOAD COMMAND 44280051 SR INREG,INREG MSG ONLY FOR EOR 44320051 LA OUTREG,MSG04I SET UP FOR END OF REEL MESSAGE 44360051 ICM OUTREG,HEX8,LMSG04I SET UP MESSAGE LENGTH 44400051 BAL CREG,CONSOLE ISSUE EOR MSG 44440051 LTR RETCODE,RETCODE ERROR ON OUTPUT? 44480051 BZ MORTPLP NO, WAIT FOR TAPE 44520051 MVI ENDUP1+1,HEXF0 SET UP UNCONDITIONAL BRANCH 44560051 B INTVWAIT GO TO INTV REQ 44600051 MORTPLP DS 0H 44640051 LH IODEVREG,CTOUTAD RESTORE OUTPUT DEV ADDRESS 44680051 AIF ('&TYPE2' NE 'HI').FX19 @ZA56338 44685800 BAL TIOREG,TIOLOOP @ZA56338 44691600 B *+8 @ZA56338 44697400 B MORTPLP @ZA56338 44703200 AGO .PFX19 @ZA57190 44709000 .FX19 ANOP @ZA57190 44715200 TIO 0(IODEVREG) WAIT TIL TAPE MOUNTED 44720051 BC 7,MORTPLP LOOP UNTIL READY 44760051 .PFX19 ANOP @ZA56338 44780000 NI CTFLG1,HEXFF-CTERROR .TURN OFF E R SW 44800051 BAL RETREG,LBLCHECK GO CHECK FOR LBL TPE 44840051 LTR RETCODE,RETCODE ERROR ON TAPE 44880051 BNZ MORTPLP YES, LOOP UNTIL READY 44920051 L CREG,SAVERET2 RESTORE CREG 44960051 NI CTFLG1,HEXFF-CTMORTPE .TURN OF EOR SW 45000051 BR CREG RETURN TO CALLER 45040051 .OUTCCWS ANOP 45080051 .* MACRO SECTION 10 @ZA27964 45120051 EJECT 45170051 AIF ('&OUTPUT2'(1,1) EQ 'T').DAE037 @ZA27964 45220051 AIF ('&IPL2'(1,1) NE 'T').PCCW SKIP TAPE CODE IF PTR 45270051 .DAE037 ANOP @ZA27964 45320051 ********************************************************************** 45450051 * * 45480051 * THIS SECTION CONTAINS THE TAPE CHANNEL PROGRAMS * 45510051 * * 45540051 ********************************************************************** 45570051 SPACE 45600051 VOL1 DC C'VOL1' STANDARD VOLUME LABEL 45630051 ASCIILAB DC XL4'564F4C31' ASCII LABEL 45650051 MSG10I DC C'02I LBL ERR' FOR STANDARD LABEL TAPES 45670051 LMSG1A DC XL1'9' LENGTH OF THE MSG1A MSG 45690051 LBLERR1 EQU MSG10I STANDARD LABEL TAPE ERROR 45710051 MSG19A DC C'19A FILE PROTECTED' FP MSG 45730051 LMSG19A DC XL1'12' MSGLENGTH 45750051 MSG04I DC C'04A EOR' END OF REEL ON TAPE 45770051 LMSG04I DC XL1'7' SET UP LENGTH OF END OF REEL MSG 45790051 SPACE 45810051 * INITIALIZATION CCW'S 45830051 SPACE 45850051 TAPERROR CCW HEX27,SENSAREA,X'60',X'01' REPOSITION CCW 45870051 CCW HEX17,SENSAREA,X'60',X'01' ERG CCW 45890051 MODE7TRK CCW HEX93,SENSAREA,X'60',X'01' MODESET CCW 45910051 MODE9TRK CCW HEXC3,SENSAREA,X'60',X'01' MODESET CCW 45930051 MODE6250 CCW HEXD3,SENSAREA,X'60',X'01' MODESET CCW @ZA04267 45950051 MODETIC CCW X'08',TAPECCW,X'60',X'01' CONTROL CCW FOR DUMP 45970051 TAPECCW CCW HEX07,SENSAREA,HEX20,HEX09 REWIND CCW 45990051 VOLABEL CCW X'02',LBLADDR,HEX20,X'04' READ VOL LABEL 46010051 RWCMD EQU TAPECCW SET UP REWIND CMD EQUATE 46030051 WRITRWD CCW WRITETPE,DUMPTITL,X'60',TITLEN WRITE CMD 46050051 CCW HEX07,SENSAREA,HEX20,HEX09 REWIND 46070051 SPACE 46090051 WTMCMDF CCW HEX1F,SENSAREA,X'60',X'01' WRITE TAPE MARK CMD 46110051 WTMCMD CCW HEX1F,SENSAREA,X'60',X'01' WRITE TAPE MARK CMD 46130051 RWULDCMD CCW X'0F',SENSAREA,HEX20,X'01' REWIND UNLOAD COMMAND 46150051 TAPERET EQU MODETIC+1 SET FOR MODIFICATION OF TIC ADDR 46170051 REWIND EQU X'07' REWIND TAPE CMD 46190051 REWINDUD EQU X'0F' REWIND UNLOAD COMMAND CODE 46210051 SPACE 46230051 * TAPE DUMP CHANNEL PROGRAMS 46250051 SPACE 46270051 WRITHEAD CCW X'01',DUMPRCD,HEXA0,8 HEADER RCD CCW 46290051 WRITECCW CCW X'01',REALADDR,HEX20,DUMPLNGH DUMP RECORD CCW 46310051 WRITETPE EQU X'01' WRITE COMMAND OP CODE 46330051 WRITDUMP EQU WRITECCW SET UP FOR LS DUMP 46350051 AIF ('&TYPE2' EQ 'LO').R1 IF LOW SKIP REAL STORAGE LOC 46370051 REALADDR EQU DUMPRCD+8 WHERE REAL STORAGE ADDR IS LOCATED 46390051 .R1 ANOP TAPE COMMON CODE 46410051 SPACE 46430051 * TAPE ERROR CHANNEL PROGRAMS 46450051 SPACE 46470051 TAPEBUS CCW HEX27,SENSAREA,X'60',X'01' REPOSITION CMD FOR BUS CK 46490051 BUSTIC CCW X'08',TAPECCW,X'60',X'01' .TIC CMD TO LINK TO USR PGM 46510051 TPEREAD EQU X'02' TAPE READ CCW 46530051 TPEWRTE EQU X'01' TAPE WRITE CMD 46550051 FSR EQU X'37' FORWARD SPACE RECORD CMD 46570051 CDC EQU X'08' CHAN DATA CHK FLAG CSW+5 @ZA27964 46590051 CCC EQU X'04' CHAN CTL CHK FLAG CSW+5 @ZA27964 46600051 TAPEREP CCW X'27',SENSAREA,X'20',X'01' REPOSITION CMD @ZA27964 46610051 .* MACRO SECTION 11 @ZA27964 46620051 AIF ('&TYPE2' EQ 'LO').OPCCW IF TYPE IS LO SKIP TO CONSOLE 46670051 AIF ('&IPL2'(1,1) EQ 'D').OPCCW IF IPLED FROM DA SKIP TAPE 46690051 EJECT 46710051 * TAPE WORK CHANNEL PROGRAM 47100051 SPACE 47130051 ********************************************************************** 47160051 * * 47190051 * NOTE: THE FOLLOWING CHANNEL PROGRAM HANDLES PROCESSING OF THE * 47220051 * WORK RECORD ON TAPE. THE SAME CODE IS USED TO PROCESS * 47250051 * WORK RECORDS ON THE SAME OR SEPARATE TAPE DEVICES FROM THE ONE * 47280051 * WHICH WAS IPLED. THE CHANNEL PROGRAM DOES THE FOLLOWING: * 47310051 * 1. WRITE A TAPE MARK ON THE TAPE FROM WHICH THE PGM WAS IPLED. * 47340051 * THIS ENABLES US TO REMEMBER WHERE WE LAST WROTE ON THE TAPE * 47370051 * 2. REWIND THE TAPE TO LOAD POINT. THIS POSITIONS US AT THE START* 47400051 * OF THE TAPE (I.E. AT THE IPL1 RECORD ON THE TAPE ) * 47430051 * 3. FORWARD SPACE BLOCK (TWICE). THIS WILL POSITION US PASS THE * 47460051 * IPL1 AND IPL2 PLUS PROGRAM TEXT CODE. NOTE THAT THIS POINTS * 47490051 * THE PROGRAM AT THE WORK RECORD. * 47520051 * 4. READ THE WORK RECORD INTO STORAGE AT LOCATION X'1000'. * 47550051 * 5. FORWARD SPACE FILE. THIS WILL POSITION THE PROGRAM JUST * 47580051 * BEYOND THE TAPE MARK WHICH WAS WRITTEN IN (1) ABOVE. * 47610051 * 6. BACK SPACE RECORD. THIS WILL POSITION THE PROGRAM JUST BEFORE* 47640051 * THE TAPE MARK TO ALLOW THE DUMP TO BE CONTINUED * 47670051 * * 47700051 ********************************************************************** 47730051 SPACE 47760051 WORKCCW CCW HEX1F,SENSAREA,X'60',X'01' WRITE TAPE MARK CMD 47790051 CCW HEX07,SENSAREA,X'60',X'01' REWIND COMMAND 47810051 CCW HEX37,SENSAREA,X'60',X'01' FORWARD SPACE BLOCK 47830051 CCW HEX37,SENSAREA,X'60',X'01' FORWARD SPACE BLOCK 47850051 TAPEWK1 CCW X'02',WORKAREA,X'60',TAPEWREC READ PAST WORK RECORD 47870051 TAPEWK2 CCW X'02',WORKAREA,HEX70,TAPEWREC READ PAST WORK RECORD 47890051 CCW HEX3F,SENSAREA,X'60',X'01' FORWARD SPACE FILE 47910051 CCW HEX27,SENSAREA,HEX20,X'01' BACK SPACE RECORD 47930051 AGO .OPCCW SET UP OPERATORS CONSOLE 47950051 .PCCW ANOP PRINTER OUTPUT DEVICE CMDS 47970051 SPACE 48090051 ********************************************************************** 48120051 * * 48150051 * THIS SECTION CONTAINS THE PRINTER CHANNEL PROGRAMS FOR DUMP * 48180051 * * 48210051 ********************************************************************** 48240051 SPACE 48270051 PTRCCW1 CCW HEX8B,SENSAREA,HEX20,X'01' SKIP TO CHAN CMD 48300051 PTRCCW2 CCW HEX11,OUTLINE,HEX20,120 PTR WRITE COMMAND 48320051 INITPCCW CCW HEX37,OUTLINE,HEX20,X'01' INITIALIZE 3800 @Z40MI3F 48340051 RELCCW CCW HEX24,0,HEX30,136 SENSE ERROR LOG FULL @Z40MI3F 48360051 PTRCHK DC XL4'020001FF' PRINTER RETRY BLOCK 48380051 .OPCCW ANOP OPERATORS CONSOLE CCW'S 48400051 H8 DC H'8' USED FOR ERROR RECOVERY ADJ OF CCW 48420051 TAPESENS CCW X'04',SENSAREA,HEX20,X'02' SENSE CCW 48440051 TABLE DC C'0123456789ABCDEF' TABLE TO TRANSLATE CSW @ZA24157 48460051 MSG14I DC C'14A INTV REQ XXX DEV' INTERVENTION REQUIRED MSG 48480051 LMSG14I DC XL1'10' SET UP LENGTH OF INTV MSG 48500051 * FOR CATASTROPHIC ERROR @ZA24157 48560051 MSG03I DC C'03I I/O ERROR ON DDD CSW= XXXXXXXXXXXXXXXX ' @ZA24157 48580051 LMSG03I DC XL1'2B' LENGTH OF MESSAGE MSG03I @ZA24157 48600051 ORG *-18 REPOSITION BACK INTO THE CSW= PART X48602500 OF THE MESSAGE. @ZA56338 48605000 WORK1 DS F USE THAT AREA AS A WORK AAREA FOR X48607500 UNPACKING THE DDD PART OF THE X48610000 MESSAGE. @ZA56338 48612500 ORG 48615000 SPACE 1 @ZA56338 48617500 MSG26I DC C'26I ERR LOADING PAGEDUMP' 48620051 LMSG26I DC XL1'18' MSG LENGTH 48640051 AIF ('&IPL2'(1,1) EQ 'T').PGELOC @YM04418 48720051 AIF ('&TYPE2' EQ 'LO').PGELOC @YM04418 48750051 LMSG13I DC XL1'19' LENGTH OF MSG 13I @YM04418 48780051 MSG13I DC C'13I ERR LOADING PRECURSOR' I/O ERROR @YM04418 48810051 .PGELOC ANOP @YM04418 48840051 AIF ('&TYPE2' EQ 'HI').FX32 @ZA67833 48840700 AIF ('&CONSOLE' NE 'C').FX31 @ZA67833 48841400 .FX32 ANOP @ZA67833 48842100 EJECT @ZA56338 48842800 *********************************************************************** 48844200 * * 48845600 * THIS SUBROUTINE IS USED TO WAIT FOR A DEVICE TO BECOME NOT BUSY. * 48847000 * THE RETURN ADDRESS IS ASSUMED TO BE IN TIOREG. * 48848400 * FOR DEVICE AVAILABLE AND DEVICE NOT OPERATIONAL THIS ROUTINE WILL * 48849800 * RETURN TO THE ADDRESS IN TIOREG AND THE CONDITION CODE FROM THE TIO * 48851200 * WILL STILL REMAIN. FOR THE CSW STORED CONDITION THIS WILL RETURN TO * 48852600 * THE ADDRESS IN TIOREG PLUS 4 AND THE CONDITION CODE WILL NOT BE * 48854000 * VALID. * 48855400 * * 48856800 *********************************************************************** 48858200 TIOLOOP DS 0H @ZA56338 48859600 MVC FLCINPSW,IONEWPSW SET UP I/O INTERRUPT HANDLER @ZA56338 48861000 TIOLOOP1 DS 0H @ZA56338 48862400 XC CSW,CSW CLEAR OLD CSW STATUS @ZA56338 48863800 TIO 0(IODEVREG) TRY TO GET TO THE DEVICE @ZA56338 48865200 BCR 9,TIOREG RETURN DIRECTLY FOR DEVICE AVAILABLE X48866600 OR NOT OPERATIONAL @ZA56338 48868000 BC 4,4(TIOREG) RETURN AT +4 FOR CSW STORED @ZA56338 48869400 CUBUSY STOSM PSWBITS,X'02' SAVE THE SYSTEM MASK AND ENABLE FOR X48870800 I/O IF TIO INDICATED BUSY @ZA67833 48872200 SSM PSWBITS RESTORE THE SYSTEM MASK IF NO X48873600 INTERRUPT OCCURED. @ZA56338 48875000 B TIOLOOP1 LOOP UNTIL NOT BUSY @ZA56338 48876400 SPACE 1 @ZA56338 48877800 IOINTRPT DS 0H I/O INTERRUPT HANDLER @ZA56338 48879200 CH IODEVREG,IOINTDEV WAS THE INTERRUPT FROM THE DEVICE X48880600 WE ARE INTERRESTED IN? @ZA56338 48882000 BNE TIOLOOP1 NO, FORGET IT. @ZA56338 48883400 B 4(TIOREG) YES, RETURN AT +4 TO INDICATE CSW X48884800 STORED. @ZA56338 48886200 IONEWPSW DS 0XL8 @ZA56338 48887600 PSWBITS DC XL1'00' SYSTEM MASK @ZA56338 48889000 DC XL4'0C000000' EC AND MACH CHK @ZA56338 48890400 DC AL3(IOINTRPT) @ZA56338 48891800 .FX31 ANOP @ZA56338 48893200 **-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-** 48894600 * 48896000 * CODE PRIOR TO THIS MUST BE CONTAINED BETWEEN ADDRESSES 48897400 * X'7000' AND X'77FF'. THEREFORE THE ADDRESS OF THE NEXT BYTE 48898800 * MUST BE LESS THAN OR EQUAL TO X'7800'. 48900200 * 48901600 **-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-** 48903000 SPACE 3 @ZA56338 48904400 MSG21I DC C'02I CMD ERR' FOR INVALID DEVICE ADDRESS @ZA56338 48905800 LMSG21I DC XL1'B' LENGTH OF MSG21I @ZA56338 48907200 AIF ('&IPL2'(1,1) NE 'D').TCCW 48909951 SPACE 48910851 ********************************************************************** 48911751 * * 48912651 * THESE CCWS READ IN THE WORK RECORD FROM DA * 48913551 * * 48914451 ********************************************************************** 48915351 SPACE 48916251 SEEKWK CCW SEEKCMD,CTCCHHR,X'60',6 48917151 SRCHWK CCW SRCHCMD,CTCCHHR+2,X'60',5 48918051 TICWK CCW TICMD,SRCHWK,X'60',1 48918951 READWK CCW DAREAD,WORKAREA+X'800',X'60',REALNGTH 48919851 CCW DAREAD,WORKAREA+X'800',HEX70,REALNGTH 48920700 CCW DAREAD,WORKAREA,HEX20,REALNGTH 48921600 SEEKCMD EQU X'07' SEEK CMD CODE 48922551 SRCHCMD EQU X'31' SEARCH CMD CODE 48923451 .TCCW ANOP TAPE CODE DEF 48924351 EJECT @ZA56338 48924500 ********************************************************************** 48924700 * * 48924900 * THIS SECTION CONTAINS THE CODE TO CHECK FOR AN ALTERNATE CONSOLE * 48925100 * * 48925300 ********************************************************************** 48925500 DS 0F @ZA56338 48925700 ALCONCTL DC XL4'07000040' @ZA56338 48925900 ALTCONCK DS 0H @ZA56338 48926100 TM CTFLG2,CTALTCON CHECK IF USING ALT CON @ZA59486 48926200 BCR 1,CREG RETURN IF IN USE @ZA59486 48926300 MVC DUMPTITL(40),EXTOLD SAVE EXT OLD PSW @ZA56338 48926400 MVC DUMPTITL+40(40),EXTNEW .SAVE IO OLD PSW @ZA56338 48926500 MVC EXTNEW(8),ALTEXPSW LOAD ALT CONSOLE EXT NEW @ZA56338 48926700 MVC FLCINPSW,ALTIOPSW LOAD ALT CONSOLE IO NEW @ZA56338 48926900 ALTCONWT DS 0H @ZA56338 48927100 LCTL 0,0,ALCONCTL LOAD CONTROL REG 0 @ZA56338 48927300 LPSW ALTPSW WAIT @ZA56338 48927500 IOINT DS 0H @ZA56338 48927700 TM CSW+4,HEX80 CHECK FOR ATTN INT @ZA56338 48927900 BZ ALTCONWT NOT ATTN RELOAD PSW @ZA56338 48928100 MVC CONADDRX,IOINTDEV CHANGE CONSOLE ADDRESS @ZA57190 48928300 EXTINT DS 0H @ZA56338 48928500 MVC EXTOLD(40),DUMPTITL RESTORE EXT OLD @ZA56338 48928700 MVC EXTNEW(40),DUMPTITL+40 I/O OLD @ZA56338 48928900 OI CTFLG2,CTALTCON TURN ON ALT CON SW @ZA56338 48929100 B CONSOLE @ZA56338 48929300 .* MACRO SECTION 12 @ZA27964 48929500 EJECT 48929700 ********************************************************************** 48930051 * * 48960051 * REAL DUMP ENTRY POINT. THIS CODE RECEIVES CONTROL AFTER THE * 48990051 * AMDSADMP PROGRAM HAS BEEN IPLED, THE WORK RECORD HAS BEEN WRITTEN * 49020051 * OUT TO A TAPE OR DIRECT ACCESS DEVICE, AND THE REAL DUMP PROGRAM * 49050051 * PROGRAM HAS BEEN READ INTO LOCATION X'7000' * 49080051 * * 49110051 ********************************************************************** 49140051 SPACE 49170051 ENTRY DS 0H MAIN AMDSADMP ENTRY POINT.THIS 49200051 * RECEIVES CONTROL FROM INIT IPL 49220051 AIF ('&IPL2'(1,1) EQ 'D').BEGIN SKIP FOR HI DA 49240051 .STATUS ANOP 49260051 STM BASEREG,RETREG,LOWCORE1 .STORE REG 12&13 IN LOC 8 49280051 LA BASEREG,7 SET UP ADDRESSABILITY 49300051 SLL BASEREG,12 FOR DUMP ROUTINE 49320051 STM SAVREG,RETCODE,DUMPTITL .STORE 0-15 IN TITLE AREA 49340051 MVC CTINADDR(2),IOADDR SAVE THE DEVICE ADDRESS FROM 49360051 MVC DUMPTITL+48(8),LOWCORE1 MOVE 12&13 IN 49380051 CLC DUMPTITL(64),STSTGPRS .COMP WITH ST ST REGS 49400051 BE SAVECSW STORE STATUS WAS DONE 49420051 OI CTFLG2,CTNOSTAT TURN ON CTNOSTAT 49440051 MVC STSTGPRS(64),DUMPTITL .MOVE TITLE REGS IN 49460051 * WHICH THE PGM WAS IPLED 49620051 .BEGIN ANOP 49650051 SPACE 49680051 ********************************************************************** 49710051 * * 49740051 * INITIALIZATION TO SAVE THE CURRENT CSW AND CAW AT DUMP TIME * 49770051 * * 49800051 ********************************************************************** 49830051 SPACE 49860051 SAVECSW DS 0H 49890051 * AND THE CAW IN THE OUTPUT DUMP 49910051 * HEADER RECORD 49930051 MVC DUMPCSW(12),CSW SAVE THE CSW FROM LOC X'40' 49950051 * AND THE CAW FROM LOC X'48' 49970051 AIF ('&TYPE2' EQ 'LO').NOTOD FOR TYPE = LO DO NOT GIVE TOD 49990051 STCK DUMPTIME OBTAIN TOD AND STORE IN HEADER RCD 50010051 BC 8,CANCEL IF VALID TOD, SKIP ZEROING TOD AREA 50030051 XC DUMPTIME(8),DUMPTIME INVALID, SET TOD = 0 50050051 .NOTOD ANOP SET UP FOR DEVICE ADDRESS 50070051 EJECT 50090051 ********************************************************************** 50110051 * * 50130051 * SET UP TO WRITE MSG AMD001A TAPE= (OR PTR=) MSG TO CONSOLE AND TO* 50150051 * PROCESS THE OPERATOR'S REPLY. @ZA27964* 50170051 * * 50190051 ********************************************************************** 50210051 SPACE 50230051 CANCEL DS 0H THIS IS THE RETRY AREA 50250051 * IF AN ERROR OCCURS 50460051 * THAT CAN BE RECOVERED. A RETURN 50490051 * IS MADE TO HERE. THE CODE IS 50520051 * REUSEABLE FROM HERE ON. 50550051 MVI TAPESW+1,HEXF0 RESET BRANCH INST 50580051 LA WORKREG1,CANCEL SET UP FOR PSW RESTART 50610051 ST WORKREG1,4 WITH ADDR OF CANCEL 50640051 NI CTFLG1,X'00' RESET FLAGS 50670051 NI CTFLG2,X'00'+CTNOSTAT RESET FLAGS WITH ONE EXCEPTION 50700051 NI CTLOWFLG,HEXFF-CTINIT TURN OF INIT SWITCH 50730051 LA MSGREG,CONSCODE SET UP FOR MSG AMD002I CMD ERR 50760051 * IF REQUIRED LATER 50790051 ICM MSGREG,HEX8,LMSG21I SET UP LENGTH OF CMD ERR MSG 50820051 XC CTEBCOPR(3),CTEBCOPR ZERO OUT THE COMM AREA 50850051 MVI CTWAIT,X'00' SET UP FOR NORMAL COMPLETION 50880051 * THIS IS DONE FOR REENTRY 50910051 LA OUTREG,MSG1A OBTAIN MSG AMD001A ADDRESS 50940051 ICM OUTREG,HEX8,LMSG1A OBTAIN LENGTH OF MSG AMD001A 50970051 LA INREG,CTEBCOPR OBTAIN THE OUTPUT DEVICE AREA 51000051 ICM INREG,HEX8,L3 SPECIFY DATA LENGTH OF 3 BYTE DEV 51030051 BAL CREG,CONSOLE GO WRITE/READ FOR MSG AMD001A 51060051 LTR RETCODE,RETCODE CHECK FOR AN I/O ERROR 51090051 BNZ DEFAULT WRITE ERROR, SKIP CONSOLE PROCESSING 51120051 OI CTLOWFLG,CTINIT TURN ON INITIALIZATION SW 51150051 AIF ('&CONSOLE' EQ 'B').CBLNK1 FOR 3066 BUFFER IS BLANK 51180051 CLC CTEBCOPR(3),CTERBDA EOB SPECIFIED? 51210051 * NOTE: CTERBDA IS 51300051 * ZERO UNTIL CLEANUP 51330051 * PROCESSING 51360051 AGO .CBLNK2 SKIP CHECK FOR 3066 51390051 .CBLNK1 ANOP 3066 BUFFER DEFAULT PROCESSING 51420051 CLC CTEBCOPR(3),HEADLNGH EOB SPECIFIED? NOTE HEADLNGH 51450051 * IS BLANKS TIL AFTER TITLE PROCESS 51470051 .CBLNK2 ANOP NORMAL PROCESSING RESUMED 51490051 BNE CONVERT YES, ASSUME DEFAULT 51510051 DEFAULT DS 0H SET UP DEFAULT DEV ADDR 51530051 OI CTFLG1,CTDEFO INDICATE BEING USED 51550051 MVC CTEBCOPR(3),CTEBCOPD SET UP FOR CONVERT 51570051 EJECT 51590051 ********************************************************************** 51610051 * * 51630051 * CONVERT THE CHARACTER DEVICE ADDRESS TO BINARY * 51650051 AIF ('&TYPE2' EQ 'HI').DAE001 @ZA27964 51670051 * THIS IS ALSO USED AS SUBROUTINE TO CONVERT THE ADDR= @ZA27964 51680051 .DAE001 ANOP @ZA27964 51690051 * * 51730051 ********************************************************************** 51750051 SPACE 51770051 CONVERT DS 0H THIS ROUTINE CONVERTS UPPER AND 51790051 * LOWER CASE LETTERS TO BINARY. IT 51810051 * USES REGISTERS 5, 6, 7, AND 8 51830051 * AS WORK REGISTERS 51850051 LA STORWORK,CTOUTAD WHERE TO PLACE CONVERTED ADDR 51870051 LA WORKREG1,3 OBTAIN NUMBER OF DIGITS TO 51890051 * CONVERT 51910051 NEXTDIG DS 0H THIS IS A LOOP TO CONVERT EACH 51930051 * DIGIT 51950051 LA WORKREG4,CTEBCOPR-1(WORKREG1) POINT TO THE DIGIT OR 51970051 * CHARACTER TO BE CONVERTED 51990051 ADDRCVT DS 0H 52010051 IC WORKREG2,0(WORKREG4) OBTAIN DIGIT/CHARACTER WHICH 52030051 * IS TO BE CONVERTED 52050051 TM 0(WORKREG4),DECIMAL TEST FOR A DECIMAL DIGIT (X'F0') 52070051 BO DIGITOK IT IS A NUMBER; SAVE THE DIGIT 52090051 OI 0(WORKREG4),CAPS MAKE REPLY ALL CAPITAL LETTERS 52110051 CLI 0(WORKREG4),A IS THE CHARACTER GREATER THAN OR 52130051 * EQUAL TO AN "A"? 52150051 BL CNVTERR NO,EXIT TO WRITE CMD ERR MSG AND TO 52170051 * REWRITE AMD001A 52190051 CLI 0(WORKREG4),F IS THE CHARACTER LESS THAN OR 52210051 * EQUAL TO AN "F"? 52230051 BH CNVTERR NO,EXIT TO WRITE CMD ERR MSG AND TO 52250051 * REWRITE MSG AMD001A 52270051 AH WORKREG2,KNINE ADD NINE TO LETER TO CONVERT THE 52290051 * LAST FOUR BITS TO A HEXDECIAML ADDR 52310051 DIGITOK DS 0H THE BINARY ADDRESS WILL BE 52330051 * ACCUMULATED IN WORKREG3 52350051 SRDL WORKREG2,4 SHIFT THE LOW ORDER FOUR BITS 52370051 * (WITH THE DEVICE ADDR) INTO WORKREG3 52390000 BCTR WORKREG4,0 DECREMENT POINTER 52410051 BCT WORKREG1,ADDRCVT LOOP UNTIL ALL DIGITS ARE CONVERTED 52430051 AIF ('&TYPE2' EQ 'HI').NOADDR 52450051 TM SWITCH,ADDCNVRT ENTRY FOR ADDR= CNVT? 52470051 BNO CONTCVT NO NORMAL CVT ERROR PROCESS 52490051 SHIFTRL SRL WORKREG3,8 SHIFT W/ LNGTH MOD BY STC INST 52510051 STCM WORKREG3,HEX7,0(STORWORK) STORE ADDR 52530051 SR RETCODE,RETCODE ZERO OUT RETURN CODE 52550051 BR RETREG RETURN TO CALLER 52570051 SPACE 5 @ZA27964 52590051 CNVTERR DS 0H 52610051 TM SWITCH,ADDCNVRT ENTRY FROM ADDR=? 52630051 BNO ERRMSG1 NO,USE NORMAL EXIT 52650051 LA RETCODE,4 SET UP ERROR RETURN CODE 52670051 BR RETREG RETURN TO CALLER 52690051 EJECT @ZA27964 52710051 AGO .CONTCVT 52730051 .NOADDR ANOP 52750051 B CONTCVT CONTINUE CONVERT 52770051 CNVTERR DS 0H 52790051 B ERRMSG1 52810051 .CONTCVT ANOP 52830051 *********************************************************************** 52850051 * 52870051 * TEST TO SEE IF OUTPUT DEV IS OK @ZA27964 52890051 * 52910051 *********************************************************************** 52930051 CONTCVT DS 0H 52950051 SRL WORKREG3,4 SHIFT THE DEVICE ADDR TO HAVE 52970051 * IN THE FORM OF 0DDD0000 52990051 STCM WORKREG3,HEXC,0(STORWORK) STORE THE 0DDD 53010051 AIF ('&TYPE2' EQ 'LO').NOINOUT 53030051 CLC CTOUTAD(2),CTINADDR IS OUTPUT = IPL 53050051 BE ERRMSG1 GO ISSUE ERROR MSG 53070051 .NOINOUT ANOP 53090051 LH IODEVREG,CTOUTAD SET UP TO VERIFY DEVICE EXISTS 53110051 AIF ('&TYPE2' NE 'HI').FX27 @ZA56338 53114000 BAL TIOREG,TIOLOOP @ZA56338 53118000 AGO .PFX27 @ZA56338 53122000 .FX27 ANOP @ZA56338 53126000 TIO 0(IODEVREG) DEVICE THERE? 53130051 .PFX27 ANOP @ZA56338 53140000 BC 1,ERRMSG1 NO, EXIT AND RETRY 53150051 AIF ('&OUTPUT2'(1,1) EQ 'P').TITLE 53170051 BAL RETREG,LBLCHECK CHECK FOR LBL TAPE 53190051 LTR RETCODE,RETCODE ERROR OCCUR 53210051 BNZ CANCEL YES,REISSUE TAPE = MSG 53230051 NI CTLOWFLG,HEXFF-CTINIT TURN OFF INIT SW 53250051 AGO .CTINIT 53270051 .TITLE ANOP TITLE PROCESSING CODE 53290051 NI CTLOWFLG,HEXFF-CTINIT TURN OFF INIT SWITCH @Z40MI3F 53914051 OI CTFLG1,CTERROR ALL CMD REJ ERROR TO G @Z40MI3F 53918051 * FOR 3800 PRINTER, IGNORE @Z40MI3F 53922051 * COMMAND REJECT @Z40MI3F 53926051 LA CCWREG,INITPCCW INITIALIZE PRINTER CCW @Z40MI3F 53930051 BAL RETREG,DUMPSIO ISSUE START I/O @Z40MI3F 53934051 NI CTFLG1,HEX7F RESET I/O ERROR FLAG @Z40MI3F 53940051 .CTINIT ANOP 53970051 EJECT 54000051 ********************************************************************** 54020051 * * 54040051 * PROMPT FOR THE TITLE AND READ IT INTO THE BUFFER FOR THE FIRST * 54060051 * RECORD, AND INITIALIZES FOR THE REAL DUMP. * 54080051 * * 54100051 ********************************************************************** 54120051 SPACE 54140051 GETITLE DS 0H THIS CODE INITIALIZES A TITLE IF THE 54160051 * CONSOLE IS AVAILABLE 54180051 LA OUTREG,MSG11D SET UP TO MSG AMD011D 54200051 ICM OUTREG,HEX8,LMSG11D OBTAIN LNGTH OF MSG AMD011D 54220051 LA INREG,DUMPTITL OVERLAY THE 1ST PART OF AMDSADMP 54240051 * CODE WITH THE 100 BYTE TITLE 54260051 ICM INREG,HEX8,L100 SPECIFY TITLE LENGTH OF 100 BYTES 54280051 MVI DUMPTITL,BLANK SET UP TO BLNK AREA 54300051 MVC DUMPTITL+1(99),DUMPTITL .AND BLANK IT OUT 54320051 BAL CREG,CONSOLE GO WRITE/READ MSG AMD011D 54340051 LA WORKREG1,100 SET UP TO CONVERT TITLE TO UPPER CASE 54360051 TITLOOP DS 0H LOOP TO CONVERT TITLE 54380051 LA WORKREG2,DUMPTITL-1 SET UP TO TITLE DATA AREA 54400051 AR WORKREG2,WORKREG1 .INCREMENT TO AREA TO CONVERT 54420051 OI 0(WORKREG2),BLANK .CONVERT TO UPPER CASE 54440051 BCT WORKREG1,TITLOOP CONVERT FULL TITLE BUFFER 54460051 DUMPHEAD DS 0H THIS CODE VIA THE INITIALIZED CCW 54480051 * DUMPS THE HEADER RECORD 54500051 .* MACRO SECTION 13 @ZA27964 54520051 EJECT 54540051 AIF ('&TYPE2' EQ 'HI').HIDUMP 54560051 ********************************************************************** 54810051 * * 54840051 * THIS CODE PRODUCES THE LOW SPEED TITLE RECORD. LOW SPEED DUMP * 54870051 * PRODUCES A HEADER RECORD CONSISTING OF THE TITLE, CURRENT PSW * 54900051 * GENERAL PURPOSE REGISTERS, CONTROL REGISTER, AND FLOATING POINT * 54930051 * REGISTERS. THE DUMP PORCESSING CODE IS THEN ENTERED. A COMMON * 54960051 * FORMAT ROUTINE IS USED TO CONVERT ALL DATA TO PRINTABLE EBCDIC * 54990051 * * 55020051 ********************************************************************** 55050051 SPACE 55080051 SR STORADDR,STORADDR .SET UP STORAGE ADDR TO LOCATION ZERO 55110051 AIF ('&OUTPUT2'(1,1) EQ 'P').PTRCCW SET UP PTR CCW IF PTR 55130051 LA CCWREG,WRITDUMP CHANNEL PROGRAM TO OUTPUT DUMP 55150051 AGO .IO1 SKIP TAPE CONTROL 55170051 .PTRCCW ANOP PRINTER CONTROL CHAR 55190051 LA CCWREG,PTRCCW1 SET UP PTR CCW.EJECT TO NEW PAGE 55210051 * TO PRINT OUT A TITLE HEADER LINE 55230051 BAL CREG,LSIO SET UP TO WRITE SPACE 55250051 LA CCWREG,PTRCCW2 WRITE MSG 55270051 .IO1 ANOP RESUME TAPE COMMON CODE 55290051 BAL CREG,LSIO GO TO COMMON LOW SPEED I/O ROUTINE 55310051 LA WORKREG1,TAPESW SET UP FOR NO PSW RESTART 55330051 ST WORKREG1,4 FROM THIS POINT ON 55350051 LCTL 0,1,CRLOC LOAD CR O AND 1 55370051 B STAP TO STORE CPU INFO FOR OTHER CPUS 55390051 * THIS RETURNS TO PSWFRMAT @ZA27964 55410051 SPACE 55560051 ********************************************************************** 55590051 * * 55620051 * THIS SECTION OUTPUTS THE CURRENT PSW FOR THE DUMP HEADER INFO * 55650051 * * 55680051 ********************************************************************** 55710051 SPACE 55740051 PSWFRMAT DS 0H 55770051 MVC OUTLINE(11),PSWMSG GET THE CURRENT PGW MSG 55800051 L STORWORK,CURRPSW OBTAIN CURRENT PSW FOR STOR 55820051 LA LINEREG,OUTDATA+9 SET UP THE LINE FOR CONVERSION 55840051 AIF ('&OUTPUT2'(1,1) EQ 'T').IO2 IF TAPE SKIP PTR CHAN CMD 55860051 MVI PTRCCW1,SPACE1 SET UP 1 LINE SPACE FOR PROT KEY 55880051 LA CCWREG,PTRCCW2 SET UP TO PRINT A LINE 55900051 AGO .IO3 SKIP TAPE CONTROL CHAR 55920051 .IO2 ANOP TAPE CONTROL FOR PROT KEY 55940051 MVI OUTCTL,SKIPSP1 SPACE PRIOR TO PRINTING 55960051 .IO3 ANOP COMMON TAPE/PTR I/O 55980051 BAL CREG,ADDRFORM CONVERT PSW TO PRINTABLE CHAR 56000051 L STORWORK,CURRPSW+4 BUMP UP TO 2ND HALF OF CURR PSW 56020051 LA LINEREG,OUTDATA+18 SET UP FOR 2ND HALF OF PWS 56040051 BAL CREG,ADDRFORM CONVERT 2ND HALF OF PSW 56060051 SPACE 56220051 ********************************************************************** 56250051 * * 56280051 * THIS SECTION OUTPUTS THE PREFIX REGISTER * 56310051 * * 56340051 ********************************************************************** 56370051 SPACE 56400051 L STORWORK,PRADDR MOVE IN PREFIX REG ADDRESS 56430051 MVC OUTDATA+37(2),PRMSG .SET UP PRE REG MSG 56450051 LA LINEREG,OUTDATA+46 .SET UP FOR LOC OF PRE REG 56470051 BAL CREG,ADDRFORM CONVERT THE REGISTER 56490051 BAL CREG,LSIO PERFORM I/O TO PRINT LINE 56510051 SPACE 56530051 ********************************************************************** 56550051 * * 56570051 * THIS SECTION INITIALIZES THE OUTPUT LINE FOR STORAGE FORMATTING. * 56590051 * THE GENERAL PURPOSE REGISTERS ARE FORMATTED AND OUTPUTTED FIRST. * 56610051 * * 56630051 ********************************************************************** 56650051 SPACE 56670051 MVI OUTASK1,ASK INITIALIZE * IN OUTPUT BUFFER 56690051 MVI OUTASK2,ASK INITIALIZE * IN OUTPUT BUFFER 56710051 LA STORWORK,GPRLOC SET UP WORK REG WITH GPR SAVE AREA 56730051 MVC OUTLINE(MSGHDLEN),FORMBUF BLANK OUT THE BUFFER 56750051 BAL RETREG,FORMAT FORMAT THE GPR IN EBCDIC 56770051 MVC OUTLINE(6),GR07 HEADING IS GR 0-7 56790051 AIF ('&OUTPUT2'(1,1) EQ 'T').IO4 SKIP PTR CTL FOR TAPE 56810051 MVI PTRCCW2,HEX09 SET UP PTR CCW TO WRITE 56830051 * THEN SPACE ONE AFTER PRINTING GPR 56850051 * FROM 0-7 56870051 .IO4 ANOP OUTPUT FORMATTED LINE OF GR 56890051 BAL CREG,LSIO OUTPUT FORMATTED LINE 56910051 BAL RETREG,FORMAT NEXT GPR'S IN BUFFER ARE 8-F 56930051 MVC OUTLINE+3(3),GR8F HEADING IS GR 8-F 56950051 AIF ('&OUTPUT2'(1,1) EQ 'T').IO5 IF TAPE SKIP PTR CTL 56970051 MVI PTRCCW2,HEX11 SET UP TO SPACE 2 AFTER 56990051 * WRITING GPR 8-F 57010051 AGO .IO6 PTR SKIPS TAPE CTL 57030051 .IO5 ANOP TAPE CTL 57050051 MVI OUTCTL,HEX40 SET UP OUTCTL TO SPACE 57070051 * PRIOR TO PRINTING GPR 8-F 57090051 .IO6 ANOP RESUME COMMON PROCESSING 57110051 BAL CREG,LSIO OUTPUT FORMATTED REGS 57130051 SPACE 57510051 ********************************************************************** 57540051 * * 57570051 * THIS SECTION INITIALIZES THE OUTPUT LINE FOR CONTROL REGS * 57600051 * THE CONTROL REGISTERS ARE FORMATTED AND OUTPUTTED NEXT * 57630051 * * 57660051 ********************************************************************** 57690051 SPACE 57720051 BAL RETREG,FORMAT CONTROL REGISTERS ARE NEXT 57750051 MVC OUTLINE(6),CR07 IN BUFFER. MOVE IN HEADING 57770051 AIF ('&OUTPUT2'(1,1) EQ 'T').IO7 IF TAPE SKIP PTR CTL 57790051 MVI PTRCCW2,HEX09 SET UP TO SKIP A LINE 57810051 * AFTER PRINTING CR 0-7 57830051 AGO .IO8 PTR SKIPS PTR CTL 57850051 .IO7 ANOP TAPE CTL 57870051 MVI OUTCTL,SKIPSP1 SET UP TO SKIP TWO LINES 57890051 * PRIOR TO PRINTING CR 0-7 57910051 .IO8 ANOP COMMON PROCESSING 57930051 BAL CREG,LSIO OUTPUT CONTROL REGS 57950051 BAL RETREG,FORMAT CONT REGS 8-F REMAIN 57970051 MVC OUTLINE+3(3),CR8F USE SAME TITLE AS GR 57990051 AIF ('&OUTPUT2'(1,1) EQ 'T').IO9 TAPE SKIPS PTR CTL 58010051 MVI PTRCCW2,HEX11 SKIP TWO LINES AFTER PRINTING 58030051 * THE CR 8-F 58050051 AGO .IO10 SKIP TAPE CTL 58070051 .IO9 ANOP TAPE CTL 58090051 MVI OUTCTL,HEX40 SKIP ONE LINE PRIOR TO PRINTING 58110051 * THE CR 8-F 58130051 .IO10 ANOP COMMON CODE AGAIN 58150051 BAL CREG,LSIO OUTPUT CR 8-F 58170051 SPACE 58410051 ********************************************************************** 58440051 * * 58470051 * THIS SECTION INITIALIZES THE OUTPUT LINE FOR F. P. REGISTERS * 58500051 * THE FLOATING POINT REGISTERS ARE FORMATTED AND OUTPUTTED NEXT * 58530051 * * 58560051 ********************************************************************** 58590051 SPACE 58620051 LA STORWORK,FPLOC1 PICKUP F.P. REGISTERS 58650051 MVC OUTLINE(6),FR02 F.P. HEADING FOR REGS 0 & 2 58670051 BAL CREG,FPFORMAT GO TO F.P. FORMAT RTN 58690051 AIF ('&OUTPUT2'(1,1) EQ 'T').IO11 TAPE SKIPS PTR CTL 58710051 MVI PTRCCW2,HEX09 SET UP TO SKIP A LINE AFTER 58730051 * PRINTING FPR 0 AND 2 58750051 AGO .IO12 PTR SKIPS TAPE CTL 58770051 .IO11 ANOP TAPE CTL 58790051 MVI OUTCTL,SKIPSP1 SET UP TO SKIP TWO LINES 58810051 * PRIOR TO PRINTING FPR 0 AND 2 58830051 .IO12 ANOP COMMON PROCESSING 58850051 BAL CREG,LSIO OUTPUT F.P. REGS 0 & 2 58870051 LA STORWORK,FPLOC2 PICK UP F.P. REGS 4 & 6 58890051 MVC OUTLINE+3(3),FR46 .PICKUP HEADING FOR F.P.4&6 58910051 BAL CREG,FPFORMAT FORMAT F.P. REGS 58930051 AIF ('&OUTPUT2'(1,1) EQ 'P').IO13 PTR SKIPS TAPE CTL 58950051 MVI OUTCTL,HEX40 SET UP TO SKIP ONE LINE 58970051 * PRIOR TO PRINTING FPR 4 AND 6 58990051 AGO .IOI99 59010051 .IO13 ANOP COMMON PROCESSING AGAIN 59030051 MVI PTRCCW2,HEX11 SET UP TO SKIP A LINE 59050051 .IOI99 ANOP 59280051 SPACE 59310051 * NOTE: THE CCW'S AT THIS POINT ARE SET UP FOR A NORMAL PRINTING * 59340051 * OF THE OUTPUT LINES TO PRINTER OR TO TAPE. * 59370051 SPACE 59400051 BAL CREG,LSIO OUTPUT F.P. REGS 4 & 6 59430051 B COMSTAP RETURN TO STAP TO CHECK FOR ADDITIONAL CPUS 59450051 DUMPLOCR DS 0H 59470051 AIF ('&OUTPUT2'(1,1) EQ 'T').IOI111 59490051 MVI PTRCCW2,HEX09 SET UP FOR NO LINE SKIP 59510051 .IOI111 ANOP 59530051 EJECT 59550051 ********************************************************************** 59640051 * * 59670051 * THIS SECTION CHECKS FOR THE ADDR= PARAMETER FOR LO SPEED AND SETS * 59700051 * UP THE ADDRESS RANGES TO BE DUMPED * 59730051 * * 59760051 ********************************************************************** 59790051 SPACE 59820051 ADDRCHCK DS 0H 59850051 NI CTFLG2,HEXFF-CTVIRTR .ZERO CTVIRTR 59870051 XC CTADDRS(8),CTADDRS ZERO ADDRESS RANGE 59890051 LA MSGREG,MSG21I SET UP CMD ERR MSG 59910051 ICM MSGREG,HEX8,LMSG21I AND LENGTH 59930051 LA OUTREG,MSG08A SET UP ADDR= MSG 59950051 ICM OUTREG,HEX8,LMSG08A AND LENGTH 59970051 MVI VIRTAREA,BLANK SET UP TO BLANK OUT 59990051 MVC VIRTAREA+1(13),VIRTAREA INPUT AREA 60010051 LA INREG,VIRTAREA SET UP INPUT ADDR 60030051 ICM INREG,HEX8,L14 AND LENGTH 60050051 BAL CREG,CONSOLE GO ISSUE MSG 60070051 LTR RETCODE,RETCODE ERROR 60090051 BNZ DEFLTAD YES,USE DEFAULT 60110051 OI VIRTAREA,CAPS MAKE RESPONSE CAPS 60130051 CLI VIRTAREA,BLANK END OF BLOCK 60150051 BE DEFLTAD USE DEFAULT 60170051 CLI VIRTAREA,R IS CHAR 1 AN R 60190051 BE CHEKADDR YES SKIP V CHECK 60210051 CLI VIRTAREA,V IS CHAR 1 V 60230051 BNE BADADDR NO OTHER IS VALID 60250051 OI CTFLG2,CTVIRTR SET UP VIRT SW 60270051 CHEKADDR DS 0H 60290051 LA STORADDR,VIRTAREA .SET ADDR OF FIELD 60310051 CLI 7(STORADDR),COMMA IS DELIMETER A COMMA 60330051 BNE BADADDR NO, BAD ADDRESS 60350051 NI SWITCH,HEXFF-TIME2 .SET 1ST TIME SW 60370051 LA STORWORK,ADDAREA1 .WHERE TO PUT CVTED ADDR 60390051 LA WORKREG4,VIRTAREA+6 .SET ADDR TO CONVERT 60410051 COMCNVRT DS 0H 60430051 LA WORKREG1,6 SET LENGTH FOR CONVERT 60450051 GOTOCVT DS 0H 60470051 OI SWITCH,ADDCNVRT SET UP INDICATE ADDR= 60490051 BAL RETREG,ADDRCVT GO TO CONVERT 60510051 NI SWITCH,HEXFF-ADDCNVRT TURN SW OFF 60530051 LTR RETCODE,RETCODE BAD ADDR 60550051 BNZ BADADDR YES ISSUE MSG 60570051 TM SWITCH,TIME2 IS THIS 2ND TIME 60590051 BO DONECVRT YES CONVERT IS DONE 60610051 LA WORKREG4,13(STORADDR) .RESET POINTER 60630051 LA STORWORK,ADDAREA2 .GET SECOND INPUT AREA 60650051 OI SWITCH,TIME2 SET SECOND TIME SW 60670051 B COMCNVRT GO TO CONVRT 60690051 DONECVRT DS 0H 60710051 CLC ADDAREA1(3),ADDAREA2 COMPARE ADDRS 60730051 BH BADADDR ADDRESSES OK 60750051 ROUDNUP DS 0H 60770051 NC CTADDRS+2(2),FOURKDWN ROUND DOWN START RNGE 60790051 L WORKREG1,CTADDRE GET END RANGE 60810051 SRL WORKREG1,12 GET RID OF LO 12 BITS 60830051 LA WORKREG1,1(WORKREG1) BUMP BY 4KBDY 60850051 SLL WORKREG1,12 GET INTO PROPER POS 60870051 ST WORKREG1,CTADDRE STORE IT IN END RANGE 60890051 TM CTFLG2,CTVIRTR VIRTUAL REQUEST 60910051 BNO SKIPVIRT SKIP VIRT PROCESSING 60930051 B VIRTREQ PROCESS VIRTUAL REQUEST 60950051 BADADDR DS 0H 60970051 LR OUTREG,MSGREG SET UP ERROR MSG 60990051 SR INREG,INREG ZERO READ IN REG 61010051 BAL CREG,CONSOLE ISSUE MSG 61030051 LTR RETCODE,RETCODE ERROR OCCUR 61050051 BZ ADDRCHCK NO, ISSUE ADDR= MSG AGAIN 61070051 DEFLTAD DS 0H 61090051 MVI CTADDRE,MAXCORE SET MAX RANGE TO X'01000000' 61110051 TM CTLOWFLG,CTVIRTD IS DEFAULT VIRTUAL 61130051 BNO SKIPVIRT SKIP VIRT PROCESS 61150051 OI CTFLG2,CTVIRTR SET VIRT REQ FLG 61170051 EJECT @ZA27964 61190051 ********************************************************************** 61210051 * * 61230051 * THIS SECTION VALIDITY CHECKS CR1 FOR A VIRTUAL ADDRESS RANGE * 61250051 * FOR A VIRTUAL REQUEST IT ASSUMES THAT STORAGE FROM 0-8000 WAS 61270051 * V=R. IF IT WAS NOT THEN THE DUMP REVERTS TO REAL ADDRESSES @ZA27964 61290051 * * 61310051 ********************************************************************** 61330051 VIRTREQ DS 0H 61350051 LCTL 0,0,CR0INIT LOAD CR 0 61370051 PTLB 61390051 MVC PGMNEW(4),EOJSW SET UP PGM CHK PSW 61410051 TM CTFLG2,CTNOSTAT WAS STORE STAT DONE 61430051 BO ALTCR1 NO, BRANCH 61450051 LA LOOPCTR,ALTCR1 SET UP PGM CK ADDR 61470051 ST LOOPCTR,PGMNEW+4 STORE IN PGM NEW PSW 61490051 LRA LOOPCTR,0(CCTREG) SET UP LOC 7000 61510051 BC 7,ALTCR1 CR1 IS INVALID 61530051 CR LOOPCTR,CCTREG CHECK FOR 1TO1 MAP 61550051 BE CR1VALID CR1 IS VALID 61570051 ALTCR1 DS 0H 61590051 LA LOOPCTR,NOCR1 SET UP PGM CK ADDR 61610051 ST LOOPCTR,PGMNEW+4 STORE IN PGM NEW PSW 61630051 LCTL 1,1,CR1ALOC LOAD CR1 WITH ALT LOC 61650051 PTLB PURGE BUFFER 61670051 LRA LOOPCTR,0(CCTREG) GET 7000 61690051 BC 7,NOCR1 BAD CTL REG 61710051 CR LOOPCTR,CCTREG IS CR1 VALID 61730051 BE CR1VALID YES BRANCH 61750051 NOCR1 DS 0H 61770051 LA OUTREG,MSG09I SET CR1 INVALID MSG 61790051 ICM OUTREG,HEX8,LMSG09I .GET LENTGH OF MSG 61810051 SR INREG,INREG ZERO READ MSG 61830051 BAL CREG,CONSOLE ISSUE MSG 61850051 LTR RETCODE,RETCODE DID ERROR OCCUR 61870051 BZ ADDRCHCK NO REISSUE ADDR= MSG 61890051 * IF CR1 IS BAD AND THE CONSOLE IS LOST DEFAULT TO ALL REAL @ZA27964 61910051 NI CTFLG2,HEXFF-CTVIRTR SET OFF VIRTUAL REQ 61930051 XC CTADDRS(8),CTADDRS .ZERO OUT RANGE 61950051 MVI CTADDRE,MAXCORE SET END RANGE TO X'01000000' 61970051 B SKIPVIRT BRANCH AROUND VIRT PROCESSING 61990051 CR1VALID DS 0H 62010051 MVI REQCHAR,V SET UP FOR VIRT IDENTIFIER 62030051 STOSM HALTPSW,X'04' TURN ON DAT BIT IN CURRENT PSW 62050051 OI EOJSW,X'04' DAT ON IN WHAT WILL BECOME PGM NEW 62070051 OI MCHKNPSW,X'04' SAME FOR MCHK NEW PSW @ZA27964 62090051 SKIPVIRT DS 0H 62110051 MVC PGMOLD(8),PGMSAVE .RESTORE PSW 62130051 MVC PGMNEW(8),PGMSAVE+8 RESTORE PSW 62150051 L STORADDR,CTADDRS SET TO START RANGE 62170051 LR STORWORK,STORADDR .FOR BOTH REGS 62190051 SPACE 2 @ZA27964 62210051 *********************************************************************** 62220051 * 62230051 * NOTE THE CODE BRANCHES AROUND THE FOLLOWING SUBROUTINES. @ZA27964 62240051 * 62250051 *********************************************************************** 62260051 B STORCOMP SKIP PAST SOME SUBROUTINES @ZA27964 62270051 EJECT 62350051 ********************************************************************** 62370051 * * 62390051 * THIS SUBROUTINE CONTAINS THE CODE TO FORMAT F.P. REGISTER 62410051 * * 62430051 ********************************************************************** 62450051 SPACE 62470051 FPFORMAT DS 0H FLOATING POINT FORMAT RTN 62490051 BAL RETREG,FORMAT GO FORMAT F.P. REGS 62510051 MVI OUTDATA+35,BLANK .BLANK OUT EXTRA CONVERTED CHAR 62530051 MVC OUTDATA+36(39),OUTDATA+35 AREA 62550051 MVC FORMBUF+17(15),OUTDATA+35 DONE SINCE F.P. USE 4 WDS 62570051 BR CREG RETURN TO CALLER 62590051 SPACE 6 @ZA27964 62610051 ********************************************************************** 62630051 * * 62650051 * THIS SUBROUTINE CONTAINS THE CODE TO WRITE OUT A FORMATTED LINE * 62670051 * * 62690051 ********************************************************************** 62710051 SPACE 62730051 DUMPWRTE DS 0H CODE TO OUTPUT THE DUMP 62750051 LSIO EQU DUMPWRTE LOW SPEED VERSION OF OUTPUT CODE 62770051 ST CREG,REGSAVE SAVE RETURN REG OVER EOR 62790051 ST LINEREG,TEMPSAVE SAVE LINEREG OVER I/O 62810051 LH IODEVREG,CTOUTAD PICK UP OUTPUT DEVICE ADDR 62830051 OUTFORM1 DS 0H FOR CHAN 12 PROCESS(PTR ONLY) 62850051 BAL RETREG,DUMPSIO OUTPUT FORMATTED LINE 62870051 AIF ('&OUTPUT2'(1,1) EQ 'P').LS1 IF PTR OUTPUT SKIP TAPE CHK 62890051 TM CSW+4,X'01' UNIT EXCEPTION? END OF REEL 62910051 BNO TAPEGOT YES, END OF TAPE REEL--GET ANOTHER 62930051 BAL CREG,MORTAPE END OF REEL PROCESS 62950051 TAPEGOT DS 0H EOR PROCESSING COMPLETED 62970051 LA CCWREG,WRITDUMP IF EOR RESTORE CCW 62990051 AGO .TP100A SET UP TAPE PROCESS 63010051 .LS1 ANOP COMMON PROCESSING AGAIN 63030051 TM CSW+4,X'04' DEVICE END CONDITION? 63050051 BO LSIOK YES, TEST FOR UNIT EXCEPTION 63070051 MVC LOWCORE2(2),CSW+2 .NO, SAVE THE CSW FOR USE IN RETRY 63090051 LIOLOOP DS 0H WAIT FOR THE DEVICE END 63110051 AIF ('&TYPE2' NE 'HI').FX21 @ZA56338 63114200 BAL TIOREG,TIOLOOP @ZA56338 63118400 AGO .PFX21 @ZA56338 63122600 .FX21 ANOP @ZA57190 63126800 TIO 0(IODEVREG) ISSUE TIO FOR DEVICE END 63130051 BC 3,LIOLOOP BUSY--CONTINUE TIO 63150051 .PFX21 ANOP @ZA56338 63160000 BC 8,LSIOK DEVICE AVAILABLE-DO MORE I/O 63170051 CLI CSW+2,X'00' CSW STORED-DEVICE END? 63190051 BNE CHECKERR CSW IS OK 63210051 MVC CSW+2(2),LOWCORE2 RESTORE CCW FOR USE 63230051 SKIPCSW1 DS 0H CHECK ERROR CONDITIONS 63250051 B CHECKERR CHECK ERRORS 63270051 LSIOK DS 0H CHECK UNIT EXCEPTION 63290051 REST100A DS 0H RESTORE FOR CHAN 12 63310051 .TP100A ANOP NO, RETURN TO CALLER 63330051 L LINEREG,TEMPSAVE ALL NORMAL RESTORE REG 63350051 L CREG,REGSAVE RESTORE RETURN REG 63370051 BR CREG RETURN TO CALLER 63390051 AIF ('&OUTPUT2'(1,1) EQ 'T').PTR100A TAPE SKIP UE FOR PTR 63410051 PTRGOT10 DS 0H FOR CHAN 12, RESTART I/O 63430051 .PTR100A ANOP GO DUMP STORAGE 63450051 EJECT 63470051 ********************************************************************** 63490051 * * 63510051 * THIS IS THE DUMP CODE TO OUTPUT AND FORMAT ALL OF REAL STORAGE * 63530051 * * 63550051 ********************************************************************** 63570051 SPACE 63590051 PRNTLOOP DS 0H LOOP TO PRINT STORAGE ONCE PER 2K 63610051 STORCOMP DS 0H 63630051 TM MCHKFLG,MCHKPE TEST TO SEE IF THE MACHINE CHECK 63650051 * HANDLER IS ALREADY SETUP @ZA27964 63670051 BO PAST1000 IF IT IS SKIP DOING IT AGAIN @ZA27964 63680051 CH STORADDR,WORKADDR .PAST X'1000' @ZA27964 63690051 BNL PAST1000 NO GO TO DUMP @ZA69934 63700000 MVC PGMNEW(8),EOJSW SET UP PGMCHK HANDLER @ZA27964 63710051 MVI MCHKFLG,MCHKPE SHOW MACH CHK SETUP DONE @ZA27964 63720051 MVC FLCMCNP(8),MCHKNPSW SETUP MCHK NEW PSW @ZA27964 63730051 LCTL 14,14,MCHKCR14 MASK OFF AS MANY TYPES AS POSSIBLE 63740051 * @ZA27964 63750051 LPSW MCHKENBL ENABLE FOR MCHK & B PAST1000 @ZA27964 63760051 PAST1000 EQU * @ZA27964 63770051 C STORADDR,CTADDRE CHECK FOR LAST ADDR 63890051 BNL DUMPDONE EXIT IF AT END OF DUMP RANGE 63910051 SR KEYREG,KEYREG INIT STORAGE KEY REG 63930051 LA LOOPCTR,LOOPCT INIT FOR 2K OF STORAGE 63950051 * THIS IS THE SPAN OF A STORAGE 63970051 * PROTECTION KEY 63990051 OI MCHKFLG,MCHKSK INDICATE IF A STOR CHK OCCURRS 64010051 * SKIP THE STORAGE KEY @ZA27964 64030051 TM CTFLG2,CTVIRTR IS THIS A VIRT DUMP 64050051 BNO NOLRAVRT NO, USE REG ISK 64070051 LRA RETCODE,0(STORADDR) GET VIRT SK ADDR 64090051 BC 7,PGMCHK STORAGE PAGED OUT SKIP BY 4K 64110051 ISK KEYREG,RETCODE GET VIRTUAL ST KEY 64130051 B STORCMPR BR AROUND ISK FOR REAL 64150051 NOLRAVRT DS 0H 64170051 ISK KEYREG,STORADDR GET STORAGE KEY 64190051 STORCMPR DS 0H 64210051 MCHKKEYS NI MCHKFLG,X'FF'-MCHKSK STOR CHK NOT EXPECT @ZA27964 64230051 C STORADDR,CTADDRE AT END OF STORAGE 64250051 BNL DUMPDONE YES DUMP IS DONE 64270051 CH KEYREG,KEYSAVE SAME AS LAST KEY? 64290051 BE WORKRCD YES, DO NOT PRINT 64310051 STH KEYREG,KEYSAVE NO, PRINT OUT 64330051 OI CTFLG2,CTSTOR INDICATE PROCESS STOR KEY 64350051 MVI OUTLINE,BLANK BLANK OUT OUTPUT LINE 64370051 MVC OUTLINE+1(119),OUTLINE FOR MSG 64390051 MVC OUTDATA(MSGHDLEN),KEYMSG MOVE IN STORAGE KEY MSG 64410051 LR SAVREG,STORWORK SET UP TO FORMAT KEY 64430051 LR STORWORK,KEYREG MOVE KEY INTO WORK REG 64450051 LA LINEREG,OUTDATA+11 .OUTPUT IN LINE PROPERLY 64470051 BAL CREG,ADDRFORM CONVERT KEY TO EBCDIC 64490051 LR STORWORK,SAVREG RESTORE WORK REG 64510051 AIF ('&OUTPUT2'(1,1) EQ 'P').LS2 BYPASS TAPE CTL FOR PTR 64530051 MVI OUTCTL,SKIPSP1 SET UP TO SKIP A LINE PRIOR 64550051 * TO PRINTING STORAGE PROTECTION KEY 64570051 MVC OUTDATA+11(6),OUTDATA+25 CLEAR STORAGE KEY BITS 64590051 LA CCWREG,WRITDUMP RESTORE CCW 64610051 BAL CREG,LSIO OUTPUT STORAGE KEY MSG 64630051 * FOR WRITING 64650051 AGO .LS3 SKIP PTR CODE FOR TAPE 64670051 .LS2 ANOP PTR CONTROL CODE 64690051 MVC OUTDATA+11(6),OUTDATA+25 CLEAR STORAGE KEY BITS 64710051 LA CCWREG,PTRCCW1 SET UP TO ORGINAL CCW TO 64730051 * SKIP A LINE IMMEDIATELY 64750051 BAL CREG,LSIO BLANK LINE 64770051 LA CCWREG,PTRCCW2 SET UP TO ORGINAL CCW TO 64790051 * PRINT A LINE 64810051 BAL CREG,LSIO OUTPUT STORAGE KEY MSG 64830051 .LS3 ANOP RESUME COMMON CODE 64850051 MVI OUTASK1,ASK SET UP LINE WITH ASK 64870051 MVI OUTASK2,ASK SET UP LINE WITH ASK 64890051 WORKRCD DS 0H CHECK FOR WORK RECORD TME 64910051 LTR STORWORK,STORWORK OUTPUTTING LOCATION ZERO? 64930051 BZ PRNTLINE YES, SKIP DUP LINE CHECKS 64950051 DUPCHK DS 0H DUPLICATE LINE CHECK 64970051 * ALSO TOP OF INNER LOOP, FOR PRINTING 64990051 * EACH LINE. @ZA27964 65010051 CH STORADDR,LOWCOREA .A CSW-CAW RESTORE? 65030051 BE INITCORE YES, RESTORE CAW AND CSW 65050051 L DUPREG,SAVEDUP CHECK FOR DUP LINE YO2006 65070051 CH STORADDR,WORKSTRT .FIRST CHECK FOR WORK 67020051 * RECORD. THIS IS DONE PRIOR TO A DUP 67050051 * LINE CHECK SINCE WORK RCD ITSELF 67080051 * MAY BE A DUP OF PREVIOUS LINE 67110051 BE GETWORK YES, HAVE WORK RECORD RESTORED 67140051 * THIS WILL RETURN AT PROTKEY @ZA27964 67160051 C STORADDR,WORKEND END OF WORK RCD? 67180051 BNE DUPLINE NO, CHECK FOR DUP LINE 67200051 NI CTFLG1,HEXFF-CTWORK .RESET WORK RECORD FLG 67220051 LR STORWORK,STORADDR .YES, RESTORE STORAGE CTR 67240051 PROTKEY DS 0H USED FOR COMP WITH HSR 67260051 DUPLINE EQU PROTKEY DUPLICATE LINE CONDITION CHECK 67280051 AIF ('&MCHK' EQ '').MTST000 @ZA27964 67300051 MCHKHOOK B MCHKSET GO TO LOOP THAT WILL SET BAD ECC 67310051 * THROUGHOUT STORAGE. @ZA27964 67320051 .MTST000 ANOP @ZA27964 67330051 OI MCHKFLG,MCHKOK INDICATE IF A STOR CHK OCCURRS SKIP 67340051 * THE PAGE BEING DUMPED @ZA27964 67350051 CLC 0(32,STORWORK),0(DUPREG) DUPLICATE LINE? 67420051 BNE PRNTLINE NO, OUTPUT LINE 67440051 TM CTFLG2,CTSTOR UNIQUE STOR KEY? 67460051 BO PRNTLINE YES, FORGET DUP LINE 67480051 SKIPMCHK NI MCHKFLG,X'FF'-MCHKOK IF THE CLC CAUSES A MACH CHK THE 67500051 * MC HANDLER BRANCHES HERE TO SKIP THE 67520051 * LINE AS IF IT WAS A DUP. @ZA27964 67540051 MCHKUNEX EQU * MACHINE CHECK HANDLER BRANCHES HERE 67550051 * TO RECOVER FROM AN UNEXPECTED MACH 67560051 * CHECK. @ZA27964 67570051 OI DUPSW,CTDUPSW YES, SET DUP SWITCH 67620051 AH STORWORK,H32 FORGET THIS LINE, SKIP 67640051 * TO THE NEXT LINE 67660051 B PRNTCTR UPDATE STORAGE KEY CTR 67680051 INITCORE DS 0H RESTORE CSW AND CAW ON FIRST 67700051 MVC CSW(12),DUMPCSW MOVE INIT CSW INTO DUMP RECORD 67720051 PRNTLINE DS 0H PRINT LINE CODE 67740051 NI MCHKFLG,X'FF'-MCHKSK STOR CHK NOT EXPECTED @ZA27964 67760051 ST STORWORK,SAVEDUP SAVE STORWORK 67780051 NI CTFLG2,HEXFF-CTSTOR RESET STOR KEY 67800051 LA LINEREG,OUTLINE SET UP OUTPUT LINE ADDR 67820051 BAL CREG,ADDRFORM CONVERT ADDR 67840051 BAL RETREG,FORMAT FORMAT THE STORAGE 67860051 TM CTFLG2,CTDUPSW WERE PREV LINES SUPPRESSED BECAUSE 67880051 * THEY WERE DUPS? @ZA27964 67900051 BNO DUMPCORE NO OUTPUT STORAGE NORMALLY 67920051 NI CTFLG2,HEXFF-CTDUPSW TURN OFF DUP LINE SWITCH 67940051 AIF ('&OUTPUT2'(1,1) EQ 'P').LP1 . LOW SPEED DUMP? 67960051 MVI OUTCTL,SKIPSP1 NO, SET UP PRINT CONTROL FOR TAPE 67980051 B PTOUT PERFORM I/O ON BLANK LINE 68000051 AGO .LP2 FORMAT NEXT LINE 68020051 .LP1 ANOP SET UP PTR FOR SKIP OF LINE 68040051 LA CCWREG,PTRCCW1 SET UP CCW CHAIN TO SKIP LINE 68060051 BAL CREG,LSIO OUTPUT LINE OF MAIN STORAGE 68080051 .LP2 ANOP COMMON OUTPUT HANDLER 68100051 DUMPCORE DS 0H NORMAL DUMP STORAGE HANDLER 68120051 AIF ('&OUTPUT2'(1,1) EQ 'P').LP3 IF PTR SKIP TAPE CONTROL 68140051 MVI OUTCTL,HEX40 TAPE PRINT CONTROL 68160051 AGO .LP4 SKIP PTR CONTROL 68180051 .LP3 ANOP PRINTER SINGLE SPACE CONTROL 68200051 LA CCWREG,PTRCCW2 SET UP FOR SINGLE SPACE 68220051 .LP4 ANOP COMMON I/O PROCESSING 68240051 PTOUT DS 0H COMMON OUTPUT ROUTINE 68260051 MVC OUTLINE+9(1),REQCHAR .MOVE IN ID CHARACTER 68280051 BAL CREG,LSIO OUTPUT LINE OF MAIN STORAGE 68300051 PRNTCTR DS 0H CYCLE THROUGH FOR EACH 2K SEC 68320051 AH STORADDR,H32 INCREMENT FOR STOR KEY CTR 68340051 BCT LOOPCTR,DUPCHK CONTINUE UNTIL DONE WITH 2K 68360051 B PRNTLOOP GET ANOTHER PROTECTION KEY 68380051 EJECT 68400051 ********************************************************************** 68420051 * * 68440051 * THIS SUBROUTINE FORMATS THE LINE PROVIDING HEXADECIMAL CONVERSIONS* 68460051 * * 68480051 ********************************************************************** 68500051 SPACE 68520051 FORMAT DS 0H FORMAT ROUTINE 68540051 LA LINEREG,OUTDATA OBTAIN OUTPUT LINE ADDR 68560051 LA BUFFREG,FORMBUF PICK UP BUFFER FORMAT ADDR 68580051 LA INCREG,1 INCREMENT FOR BXLE INSTRUCTION 68600051 LA LIMITREG,31(BUFFREG) SET UP FOR END OF BXLE 68620051 MVC FORMBUF(32),0(STORWORK) MOVE IN THE LINE TO BE 68640051 * CONVERTED TO HEX 68660051 TESTF DS 0H LOOP FOR CONVERTING ALL CHARS 68680051 TM 0(BUFFREG),HEXC0 .AN ALPHNUMERIC CHAR? 68700051 BO ALRIGHT YES, CONVERT THE CHAR 68720051 CLI 0(BUFFREG),BLANK .A BLANK CHARACTER? 68740051 BE BXLE YES, CONVERT BLANK TO HEX CHAR 68760051 MVI 0(BUFFREG),X'00' .FORCE ALL OTHER CHAR TO BLANK 68780051 ALRIGHT DS 0H PREPARE TO CONVERT CHAR TO EBCDIC 68800051 NI 0(BUFFREG),HEX3F .STRIP OFF HIGH ORDER BYTES FOR 68820051 * SHORTER TRANSLATE TABLE 68840051 BXLE BXLE BUFFREG,INCREG,TESTF CONVERT FROM HEX TO EBCDIC 68860051 TR FORMBUF,TRANLATE TRANSLATE CHARACTERS TO EBCDIC 68880051 SPACE 68900051 ********************************************************************** 68920051 * * 68940051 * CONVERSION FROM THE HEX DIGIT TO A PRINTABLE HEX * 68960051 * (ALSO USED BY ADDRFORM SUBROUTINE). @ZA27964 68980051 * * 69000051 ********************************************************************** 69020051 SPACE 69040051 FORMCORE DS 0H FORMAT OF STORAGE 69060051 LA LOOPREG1,2 FOR SIZE OF COLUMNS 69080051 LOOP1 DS 0H LOOP FOR THE TWO SIDES OF DUMP 69100051 * RIGHT HAND SIDE (RHS) AND LEFT HAND 69120051 * SIDE (LHS) 69140051 LA LOOPREG2,4 SET UP STORAGE SECTION FOR SIDES 69160051 * OF EACH COLUMN 69180051 LOOP2 DS 0H SECOND INNER LOOP FOR CONVERT 69200051 MVC WORK(4),0(STORWORK) OBTAIN STORAGE 69220051 * TO CONVERT. THIS IS DONE IN ORDER 69240051 * TO PREVENT AN ADDRESSING EXCP 69260051 UNPK 0(9,LINEREG),WORK(5) CONVERT 4 BYTES OF DATA 69280051 MVI 8(LINEREG),BLANK CLEAR SIGN BIT 69300051 TR 0(8,LINEREG),HEXTAB-240 CONVERT TO PRINTABLE HEX 69320051 LA LINEREG,9(LINEREG) BUMP LINE COUNT 69340051 LA STORWORK,4(STORWORK) BUMP STORAGE ADDR 69360051 BCT LOOPREG2,LOOP2 SET UP LHS OF LINE 69380051 LA LINEREG,1(LINEREG) AFTER LHS COMPLETE MUST SKIP 69400051 * THREE SPACES IN THE CENTER COLUMN 69420051 BCT LOOPREG1,LOOP1 LOOP TO COMPLETE RHS 69440051 BR RETREG RETURN TO CALLER 69460051 EJECT 69480051 ********************************************************************** 69500051 * * 69520051 *THIS SUBROUTINE CONVERTS AN ADDR OR STOR KEY IN REG STORWORK TO EBCDIC 69540051 * * 69560051 ********************************************************************** 69580051 SPACE 69600051 ADDRFORM DS 0H CONVERT FOUR BYTES IN REG STORWORK 69620051 LA LOOPREG1,1 SET UP FOR FORMCORE A 4 BYTE CONV 69640051 LA LOOPREG2,1 SMALL LOOP 69660051 STCM STORWORK,HEXF,ADDRSAVE SAVE ADDR TO CONVERT 69680051 TM CTFLG1,CTWORK A WORK RECORD? 69700051 BNO ADRFORM1 NO, SKIP WORK PROCESSING 69720051 TM CTFLG2,CTSTOR STOR KEY IN PROCESS? 69740051 BO ADRFORM1 YES, HANDLE UNIQUELY 69760051 STCM STORADDR,HEXF,TEMPSAVE YES, SET UP REAL ADDR 69780051 LA STORWORK,TEMPSAVE .POINT TO REAL ADDR 69800051 B ADRFORM2 HANDLE AS NORMAL 69820051 ADRFORM1 DS 0H SET UP FOR NORMAL ADDR 69840051 LA STORWORK,ADDRSAVE SET UP CONVERSION 69860051 ADRFORM2 DS 0H NORMAL WORK PROCESSING 69880051 BAL RETREG,LOOP2 CONVERT THE ADDR 69900051 ICM STORWORK,HEXF,ADDRSAVE RESTORE ADDRESS IN REG 69920051 BR CREG RETURN TO CALLER 69940051 AGO .WORK1 GET LS WORK RECORD 69960051 .* MACRO SECTION 14 @ZA27964 69980051 .HIDUMP ANOP HIGH SPEED DUMP PROCESSING 70000051 L STORADDR,STARTADR .INITIALIZE REAL STORAGE ADDR 70020051 LR STORWORK,STORADDR .INIT WORK REG ADDR--STORAGE DUMPED 70040051 AIF ('&IPL2'(1,1) EQ 'T').SKPWKFL 70060051 MVC CCHHW(4),CTCCHHW INITIALIZE WKFILE CCHHW 70080051 MVI SEEKADDR+6,0 INITIALIZE WORKFILE TO RCD 0 70100051 L WORKREG2,IDAWORD GET ADDRESS OF COUNT AREA 70120051 XC 0(8,WORKREG2),0(WORKREG2) .ZERO COUNT FLD 70140051 MVC 6(2,WORKREG2),FOURK .SET UP FOR LNGTH OF 4K 70160051 .SKPWKFL ANOP 71310051 SPACE 71340051 ********************************************************************** 71370051 * * 71400051 * REAL STORAGE DUMPING LOOP * 71430051 * * 71450051 ********************************************************************** 71470051 SPACE 71490051 DUMPWRTE DS 0H CODE TO OUTPUT THE DUMP 71510051 LH IODEVREG,CTOUTAD OBTAIN OUTPUT DEVICE ADDR 71530051 LA CCWREG,WRITHEAD OBTAIN CHANNEL PGM TO 71550051 * OUTPUT DUMP; ON THE FIRST PASS THIS 71570051 * IS THE HEADER RECORD. 71590051 BAL RETREG,DUMPSIO WRITE THE 4K DUMP RECORD 71610051 TM CSW+4,X'01' END OF REEL ON THE TAPE? 71630051 BNO STAPROC NO, PREPARE TO ISSUE STAP 71650051 BAL CREG,MORTAPE END OF REEL CONDITION 71670051 STAPROC DS 0H 71690051 LA WORKREG1,TAPESW NO PSW RESTART 71710051 ST WORKREG1,4 FROM HERE ON 71730051 LTR STORADDR,STORADDR CHECK PTR ADDR 71750051 BM STAP WHICH WILL STOP ANY OTHER CPU & WRITE 71770051 * THE CPU RECS, THEN RETURN AT LABEL 71790051 * TAPEGOT @ZA27964 71810051 *********************************************************************** 71830051 * * 71850051 * FOR THE FIRST 128K OF THE DUMP ALSO WRITE A DUPLICATE ON THE IPL * 71870051 * DEVICE AS A WORK FILE TO BE READ BY THE VIRTUAL DUMP WHEN IT NEEDS * 71890051 * DATA THAT SHOULD BE IN THE FIRST 128K. @ZA27964 71910051 * * 71930051 *********************************************************************** 71950051 WKFLDUMP DS 0H 71970051 TM CTFLG2,CTWKDONE DONE WITH WORKFILE 71990051 BO TAPEGOT SKIP WKFILE PROCESS @ZA27964 72010051 C STORADDR,ONE28K PAST 128 K 72030051 BNL WKFLDONE SKIP IF DONE 72050051 OI CTFLG1,CTERREC TURN ON NO CAT ERR REC 72070051 LH IODEVREG,CTINADDR .PICK UP IPL DEV 72090051 AIF ('&IPL2'(1,1) NE 'D').LODA 72110051 LA WORKREG1,TABLNG GET DEVICE TABLE ADDR 72130051 DEVLOOP DS 0H 72150051 TM 0(WORKREG1),ENDTAB .AT END OF TABLE ? 72170051 BO WKFLDONE YES, NO DEV FOR WKFILE 72190051 CLC 5(1,WORKREG1),CTDEVTYP CHECK FOR DEV TYPE 72210051 BE DEVOK DEVICE FOUND 72230051 LA WORKREG1,8(WORKREG1) .BUMP TO NEXT ENTRY 72250051 B DEVLOOP CONTINUE SEARCH 72270051 DEVOK DS 0H 72290051 ST WORKREG1,DEVSAVE SAVE DEV ADDR FROM TABLE 72310051 CLC 2(2,WORKREG1),CCHHW+2 .OVER CYL BOUNDRY ? 72330051 BH NOINCREM NO DO NOT INCREMENT 72350051 L WORKREG2,CCHHW PICK UP WKFILE CCHH 72370051 SRL WORKREG2,16 STRIP OFF HH 72390051 LA WORKREG2,1(WORKREG2) .BUMP CYL BY 1 72410051 SLL WORKREG2,16 SHIFT FOR HH OF 0 72430051 ST WORKREG2,CCHHW STORE NEW CCHH IN CTCCHHW 72450051 NOINCREM DS 0H 72470051 CLC CCHHW(4),CTCCHHE OVER END OF DATA SET 72490051 BH SETWKFSW YES NO MORE WKFILE 72510051 MVC SEEKADDR+2(4),CCHHW .OBTAIN WORKFILE CCHHR 72530051 ST STORWORK,IDAWORD1 .SET UP 1ST 2K BLOCK FOR WRITE 72550051 LA WORKREG1,2048(STORWORK) .SET UP 2ND BLOCK 72570051 ST WORKREG1,IDAWORD2 .STORE ADDRESS FOR WRITE 72590051 L WORKREG2,IDAWORD GET COUNT FIELD AREA 72610051 MVC 0(4,WORKREG2),CCHHW .STORE CCHH OF RCD 72630051 IC WORKREG1,SEEKADDR+6 .GET SRCH RCD NUMBER 72650051 LA WORKREG1,1(WORKREG1) .ADD 1 FOR WRITE RCD NUMBER 72670051 STC WORKREG1,4(WORKREG2) .STORE RCD NUMBER 72690051 LA CCWREG,WKRCDCCW SET UP CHANNEL PGM 72710051 OI CTFLG1,CTDEVICE SET DA I/O SW ON 72730051 BAL RETREG,DUMPSIO GO WRITE RECORD 72750051 NI CTFLG1,HEXFF-CTDEVICE .TURN OFF DA I/O 72770051 TM CTFLG1,CTERREC DID ERROR OCCUR ? 72790051 BNO WKFLDONE YES, NO MORE WKFL 72810051 NI CTFLG1,HEXFF-CTERREC TURN OFF ERROR FLG 72830051 ST STORADDR,CTLWKAD SAVE LAST WORK RCD DUMPED 72850051 L WORKREG1,DEVSAVE OBTAIN DEV ADDR IN TABLE 72870051 CLC 7(1,WORKREG1),SEEKADDR+6 ONE RCD PER TRK 72890051 BE ONERECRD YES, BRANCH 72910051 IC WORKREG1,SEEKADDR+6 .GET RECORD 72930051 LA WORKREG1,1(WORKREG1) .BUMP IT BY ONE 72950051 STC WORKREG1,SEEKADDR+6 .STORE IT IN SEEK 72970051 B ENDWKFLE DONE WRITING RECORD 72990051 ONERECRD DS 0H 73010051 MVI SEEKADDR+6,0 SET RECORD TO 0 73030051 ONEPERTK DS 0H 73050051 LH WORKREG2,CCHHW+2 OBTAIN HH PORTION 73070051 LA WORKREG2,1(WORKREG2) .BUMP HH BY 1 73090051 STH WORKREG2,CCHHW+2 .STORE IT INTO CCHHW 73110051 B ENDWKFLE DONE WITH WORK FILE 73130051 AGO .HIWKFLE 73150051 .LODA ANOP 73170051 LA CCWREG,WRITHEAD OBTAIN CHANNEL PGM TO 73190051 BAL RETREG,DUMPSIO DUMP WORK FILE RECORD 73210051 TM CTFLG1,CTERREC DID ERROR OCCUR 73230051 BNO WKFLDONE YES SET END SW 73250051 NI CTFLG1,HEXFF-CTERREC TURN OFF ERROR SW 73270051 ST STORADDR,CTLWKAD SAVE LAST WKFILE ADDR 73290051 TM CSW+4,X'01' EOR ? 73310051 BNO ENDWKFLE NO SKIP END SW SET 73330051 .HIWKFLE ANOP 73350051 SETWKFSW DS 0H 73370051 OI CTLOWFLG,CTWKSTUS .INDICATE EOR OR END OF EXTENTS 73390051 WKFLDONE DS 0H 73410051 OI CTFLG2,CTWKDONE TURN ON WKFILE DONE 73430051 ENDWKFLE DS 0H 73450051 TM MCHKFLG,MCHKPE TEST TO SEE IF THE MACHINE CHECK 73470051 * HANDLER IS ALREADY SETUP. THIS IS 73490051 * NOT DONE UNTIL AFTER THE FIRST 4K 73510051 * (PSW ETC.) HAS BEEN DUMPED, & WRITTEN 73530051 * TO THE WORK FILE @ZA27964 73550051 BO TAPEGOT IF IT IS SKIP DOING IT AGAIN @ZA27964 73560051 OI MCHKFLG,MCHKPE SHOW MACH CHK SETUP DONE @ZA27964 73570051 MVC FLCMCNP(8),MCHKNPSW SETUP MCHK NEW PSW @ZA27964 73580051 MVC PGMNEW(8),EOJSW SET UP PGM CHK HANDLER. WHEN A 73590051 * MISSING STORAGE BOX OR THE END OF 73600051 * STORAGE IS REACHED A PGM CHK WILL 73610051 * SHIFT CNTL TO LABEL PGMCHK. @ZA27964 73620051 LCTL 14,14,MCHKCR14 MASK OFF AS MANY TYPES AS POSSIBLE 73630051 * @ZA27964 73640051 LPSW MCHKENBL ENABLE FOR MCHK & B TAPEGOT @ZA27964 73650051 MCHKUNEX EQU * MACHINE CHECK HANDLER BRANCHES HERE 73660051 * TO RECOVER FROM AN UNEXPECTED MACH 73670051 * CHECK. @ZA27964 73680051 TAPEGOT DS 0H EOR PROCESSING COMPLETED 73830051 A STORADDR,INCRBLKS .INCREMENT STORADDR BY 4K 73850051 A STORWORK,INCRBLKS .INCREMENT STORWORK BY 4K 73870051 CH STORADDR,WORKSTRT .IS THIS THE START OF THE 1ST WORK 73890051 * RECORD SAVED AT IPL? @ZA27964 73910051 BE GETWORK YES, GET IT @ZA27964 73920051 C STORADDR,WORKEND END OF 1ST IPL WORK RECORD? @ZA27964 73930051 AIF ('&IPL2'(1,1) NE 'T').RESET @ZA27964 73940051 BE GETWORK GET THE 2ND IPL WORK RECORD @ZA27964 73950051 C STORADDR,ENDWKRCD .END OF 2ND IPL WORK RECORD? @ZA27964 73960051 .RESET ANOP 73970051 BNE PROTKEY NO, GET STORAGE PROTECT KEY @ZA27964 73980051 LR STORWORK,STORADDR .RESET STORAGE ADDR TO NORMAL 73990051 PROTKEY DS 0H PROCESSING TO OBTAIN PROTECTION KEY 74000051 OI MCHKFLG,MCHKSK INDICATE IF A STOR CHK OCCURRS 74010051 * SKIP GETTING THE KEYS. @ZA27964 74020051 ISK KEYREG,STORADDR OBTAIN KEY OF CURRENT ADDR BLK. 74030051 * NOTE THAT IF THE ADDR DOESN'T EXIST 74040051 * A PGM CHK WILL OCCURR EFFECTIVELY 74050051 * BRANCHING TO PGMCHK @ZA27964 74060051 C STORADDR,HIGHEST AT END OF STORAGE? 74230051 BNL DUMPDONE YES DUMP IS DONE 74250051 STC KEYREG,KEY1 PLACE IN HEADER FOR REAL RCD 74270051 LA WORKREG1,HEX800 SET TO GET NEXT 74290051 AR WORKREG1,STORADDR .STORAGE KEY 74310051 ISK KEYREG,WORKREG1 PICK UP 2ND STORAGE KEY 74330051 STC KEYREG,KEY2 PLACE IN HEADER RCD 74350051 MCHKKEYS NI MCHKFLG,X'FF'-MCHKSK NO MORE MACH ON ISK @ZA27964 74370051 AIF ('&MCHK' EQ '').MTST001 @ZA27964 74380051 MCHKHOOK B MCHKSET GO TO LOOP THAT WILL SET BAD ECC 74390051 * THROUGHOUT STORAGE. @ZA27964 74400051 .MTST001 ANOP @ZA27964 74410051 ST STORADDR,ADDR PLACE ADDR IN OUTPUT RCD 74420051 STCM STORWORK,HEX7,WRITECCW+1 SET REAL STORAGE ADDR 74430051 B DUMPWRTE GO OUTPUT THE RECORD 74440051 .* MACRO SECTION 15 @ZA27964 74450051 .WORK1 ANOP WORK RECORD PROCESSING 74550051 EJECT 74570051 ********************************************************************** 75180051 * * 75210051 * THIS CODE OBTAINS THE WORK RECORD * 75240051 * * 75270051 ********************************************************************** 75300051 SPACE 75330051 GETWORK DS 0H OBTAIN WORK RECORD FROM IPL DEV 75360051 LH IODEVREG,CTINADDR .OBTAIN IPL DEVICE ADDR 75390051 AIF ('&IPL2'(1,1) EQ 'D').WK1 SET UP FOR DA WORK RCD 75420051 LA CCWREG,WORKCCW PICK UP WORK CCW CHAIN 75450051 CH STORADDR,WORKSTRT .CHECK FOR 1ST RCD 75480051 BE WORKSIO 75510051 SCNDREAD DS 0H 75540051 MVI TAPEWK1+4,HEX70 SET NO DATA READ1 75570051 MVI TAPEWK2+4,X'60' SET CMD CHAIN 75600051 WORKSIO DS 0H 75630051 BAL RETREG,DUMPSIO DUMP WORK RECORD IN STORAGE 75660051 AGO .WKISOK CHECK FOR TAPE PROCESSING 75690051 .WK1 ANOP DA WORK RECORD PROCESSING 75720051 LA CCWREG,SEEKWK SET UP CHAN PGM 75750051 OI CTFLG1,CTDEVICE DET DA I/O SW ON 75780051 OI CTFLG1,CTWORK TURN ON WORK RCD FLG 75810051 BAL RETREG,DUMPSIO 75840051 NI CTFLG1,HEXFF-CTDEVICE 75870051 AIF ('&TYPE2' EQ 'HI').WKISOK HI SKIPS WORK BIT 75900051 .LOGETWK ANOP 75930051 AIF ('&OUTPUT2'(1,1) EQ 'P').WORK2A FOR PTR SKIP RESET CCW 75960051 LA CCWREG,WRITDUMP RESET CCW FOR TAPE 75990051 .WORK2A ANOP RESUME COMMON TAPE PROCESSING 76020051 LR DUPREG,STORWORK RESTORE DUP SW 76050051 SH DUPREG,H32 BACK UP ONE LINE 76080051 .WKISOK ANOP RESTORE STORAGE WORK 76110051 LH STORWORK,WORKADDR .SET UP WORK REG TO DUMP WORK RCD 76140051 B PROTKEY GET PROTECTION KEY FOR WORK AREA 76170051 EJECT 76200051 ********************************************************************** 76230051 * * 76260051 * THIS SUBROUTINE CONTAINS THE CODE THAT ISSUES THE STAP INSTRUCTION 76290051 * IN ORDER TO OBTAIN THE CPU RECORD INFORMATION FOR THE IPL CPU AND * 76380051 * ANY OTHER ATTACHED CPU'S * 76410051 * * 76440051 ********************************************************************** 76470051 SPACE 76500051 STAP DS 0H 76530051 AIF ('&TYPE2' EQ 'LO').SHRTSAV 76550051 XC WRITECCW+1(3),WRITECCW+1 .ZERO DUMP ADDRESS 76570051 MVC PGMSAVE(104),PGMOLD SAVE PGM PSWS & INT CD @ZA06479 76590051 AGO .CPUID 76610051 .SHRTSAV ANOP 76630051 MVC PGMSAVE(8),PGMOLD .SAVE PGM OLD 76650051 MVC PGMSAVE+8(8),PGMNEW SET UP PGM NEW 76670051 .CPUID ANOP 76690051 MVC PGMNEW(8),STAPSW SET UP PGM NEW PSW @ZA27964 76710051 LA LOOPCTR,X'3F' SET LOOP INDEX TO END CONDITION TO 76720051 * AVOID SIGP LOOP FOR NONMP @ZA27964 76730051 SR WORKREG1,WORKREG1 .SET COUNTER TO ZERO 76740051 STAP CTCPUI IF THIS IS NO AN MP THIS INST WILL 76750051 * PGM CHK CAUSING CONTROL TO GO TO 76760051 * LABEL=NOMP @ZA27964 76770051 OI CTFLG1,CTMP SET CTMP BIT ON 76850051 SR LOOPCTR,LOOPCTR ZERO LOOPCTR 76870051 BCTR LOOPCTR,0 AND SET IT TO -1 76890051 NOMP DS 0H 76910051 MVC CPUADDR(2),CTCPUI .OBTAIN CPU ADDRESS 76930051 AIF ('&TYPE2' EQ 'HI').SKIPCPU 76950051 WRITSTAT DS 0H 76970051 LH STORWORK,CPUADDR GET CPU ADDR 76990051 MVI OUTLINE,BLANK BLANK OUT THE OUTPUT AREA 77010051 MVC OUTLINE+1(119),OUTLINE BLANK OUT ENTIRE AREA 77030051 MVC OUTDATA+57(6),CPUIDMSG MOVE IN CPU ID TEXT 77050051 LA LINEREG,OUTDATA+64 .SET UP FOR ID POSITION 77070051 BAL CREG,ADDRFORM 77090051 MVC OUTDATA+64(6),OUTLINE BLANK OUT LEADING DIGITS 77110051 B PSWFRMAT RETURN TO CALLER TO PRINT DATA 77130051 AGO .COMSTAP 77150051 .SKIPCPU ANOP 77170051 XC RESERVD(3),RESERVD .ZERO RESVD FIELD 77190051 MVI RECID,X'0F' SET RCDID 77210051 TM CTFLG2,CTNOSTAT WAS STORE STATUS DONE 77230051 BNO SETRECID YES, SKIP FLG SETTING 77250051 OI STAFLAGS,X'60' SET STATUS FLAG ON 77270051 SETRECID DS 0H 77290051 TM CTFLG1,CTMP IS THIS AN MP MACHINE 77310051 BO WRITSTAT 77330051 OI STAFLAGS,HEX80 SET HDR FLAGW 77350051 WRITSTAT DS 0H 77370051 LA CCWREG,WRITHEAD SET UP TO GO TO DUMPSIO 77390051 ST LOOPCTR,LCSAVE SAVE ACROSS CALLS TO DUMPSIO AND X77396600 MORTAPE @ZA56338 77403200 BAL RETREG,DUMPSIO GO DUMP RECORD 77410051 TM CSW+4,X'01' END OF REEL 77430051 BNO NOEOR NO 77450051 BAL CREG,MORTAPE GO GET MORE TAPE 77470051 NOEOR DS 0H 77490051 L LOOPCTR,LCSAVE RESTORE AFTER CALLS TO DUMPSIO AND X77496600 MORTAPE @ZA56338 77503200 XC STAFLAGS,STAFLAGS .ZERO FLAGS 77510051 .COMSTAP ANOP 77530051 COMSTAP DS 0H 77550051 LA WORKREG1,HEX3F SET UP MAX CPU COUNT 77570051 SR WORKREG1,LOOPCTR TEST FOR END OF CPU COUNT 77590051 BZ STAPDONE IF AT END, EXIT 77610051 LA LOOPCTR,1(LOOPCTR) .INCREMENT COUNTER 77630051 CH LOOPCTR,CTCPUI IPL CPU 77650051 BE COMSTAP SKIP IF IPL CPU 77670051 STH LOOPCTR,CPUADDR STORE CPU ADDRESS 77690051 SIGP WORKREG2,LOOPCTR,SIGPSTAT ISSUE SIGP 77710051 AIF ('&TYPE2' EQ 'LO').NOCHCK 77730051 BC 1,COMSTAP CPU NOT PRESENT 77750051 BC 8,STOPCPU SUCCESSFUL 77770051 OI STAFLAGS,HEX40 TURN ON INVALID STATUS 77790051 B WRITSTAT GO WRITE STATUS RECORD 77810051 AGO .STPDONE 77830051 .NOCHCK ANOP 77850051 BC 8,STOPCPU SIGP WAS SUCCESSFUL 77870051 B COMSTAP SKIP CPU IF NOT 77890051 .STPDONE ANOP 77910051 STOPCPU SIGP WORKREG2,LOOPCTR,SIGPSTOP .ISSUE SIGP STOP 77930051 BC 2,STOPCPU LOOP UNTIL NOT BUSY 77950051 B WRITSTAT WRITE STATUS RECORD 77970051 STAPDONE DS 0H 77990051 AIF ('&TYPE2' EQ 'LO').LOSHRT 78010051 MVC PGMOLD(104),PGMSAVE RESTORE PGM PSWS,INT CD @ZA06479 78030051 AGO .RETURN 78050051 .LOSHRT ANOP 78070051 B DUMPLOCR 78090051 AGO .LOBRNCH 78110051 .RETURN ANOP 78130051 B TAPEGOT 78150051 .LOBRNCH ANOP 78170051 .* MACRO SECTION 16 @ZA27964 78190051 EJECT 78210051 ********************************************************************** 78960051 * THIS IS THE PROGRAM CHECK CLEAN-UP PROCESSOR. IT CLEANS UP THE * 78990051 * DUMP PROCESSING (UNLOAD TAPE) AND EITHER GETS THE PRECURSOR RTNE * 79020051 * IF A PAGE DUMP IS DESIRED, OR LOADS A WAIT STATE PSW. CONTROL IS * 79050051 * RECEIVED VIA A PROGRAM CHECK WHEN ALL THE REAL STORAGE DUMP HAS BEEN 79080051 * COMPLETED. FOR LOW-SPEED DUMPS, THE ROUTINE CLEANS UP * 79110051 * AND TERMINATES NORMALLY. * 79140051 ********************************************************************** 79170051 SPACE 79200051 PGMCHK DS 0H THE FINAL CLEAN-UP PROCESSOR 79230051 NI MCHKFLG,X'FF'-MCHKSK INDICATE STORAGE CHECKS ARE NO 79260051 * LONGER EXPECTED. @ZA27964 79270051 AIF ('&TYPE2' EQ 'LO').LOCHK IF LOW-SPEED 79280051 C STORADDR,HIGHEST AT END OF STORAGE? 79290051 BNL DUMPDONE YES 79300051 A STORADDR,COREBOX JUMP OVER CHECKED COREBOX 79310051 LR STORWORK,STORADDR SAME FOR STORWORK 79380051 B PROTKEY GET STORAGE KEY 79410051 AGO .NOHIC 79440051 .LOCHK ANOP 79470051 C STORADDR,CTADDRE AT END OF LOW DUMP? 79500051 BNL DUMPDONE YES 79530051 AH STORADDR,FOURK BUMP ADDR BY 4K 79560051 * SINCE FOR VIRT DUMPS THIS PAGE IS NOT 79567051 * IN REAL (INVALID) AND FOR REAL DUMPS 79574051 * THIS STOR BOX MAY BE OFFLINE @ZA27964 79581051 OI CTFLG2,CTDUPSW SET UP TO SKIP LINE 79590051 LR STORWORK,STORADDR SAME FOR STORWORK 79620051 B STORCOMP 79650051 .NOHIC ANOP 79680051 DUMPDONE DS 0H 79710051 NI PGMNEW+1,X'FB' CHANGE PGM CHK NEW PSW TO BE DISABLED 79740051 * FOR MACH CHKS @ZA27964 79745051 LPSW MCHKDSBL DISABLE FOR MACH CHKS NOW THAT ALL 79749051 * REAL STOR HAS BEEN DUMPED. @ZA27964 79753051 MCHKOUT EQU * MCHKDSBL PSW RESUMES HERE. @ZA27964 79757051 AIF ('&MCHK' EQ '').MTST003 @ZA27964 79761051 DC X'8300',S(MCHKDG3) TURN HARDWARE BUF BACK ON @ZA27964 79765051 .MTST003 ANOP @ZA27964 79769051 MVI ENDUP1+1,HEXF0 SET BR FOR END PROCESSING 79780051 MVI ENDUP2+1,NOP SET BR TO NOP 79785051 LA OUTREG,ENDMSG ONLY EXIT NOW IS NORMAL DUMP 79800051 * COMPLETED SUCCESSFULLY MSG 79830051 ICM OUTREG,HEX8,LMSG05I LENGTH OF MSG 79860051 SR INREG,INREG SET UP FOR DUMP ENDED MSG 79890051 BAL CREG,CONSOLE GO PRINT END MSG 79920051 AIF ('&TYPE2' EQ 'HI').CALLPRO 79950051 B CLEANUP 79980051 AGO .EQUATES 80010051 .* MACRO SECTION 17 @ZA27964 80040051 .CALLPRO AIF ('&IPL2'(1,1) EQ 'T').CALLPGE 80040351 EJECT 80040451 *************************************************************@ZA17663* 80040551 * @ZA17663* 80040651 * LOAD THE PRECURSOR PROGRAM TO MAKE THE LINKAGE TO @ZA27964* 80040751 * THE VIRTUAL DUMP PHASE. BECAUSE THE PRECURSOR WILL @ZA27964* 80040851 * OVERLAY THE LAST HALF OF THIS MODULE, THE PORTION OF @ZA27964* 80040951 * THIS LOGIC THAT FOLLOWS THE RETURN FROM DUMPSIO IS @ZA27964* 80041051 * LOCATED IN THE FIRST HALF OF THE MODULE. @ZA27964* 80041151 * @ZA17663* 80041351 *************************************************************@ZA17663* 80041451 SPACE 1 @ZA17663 80041651 GETPRO DS 0H PRECURSOR INTERFACE RTN @ZA17663 80041851 OI CTFLG1,CTDEVICE SET UP DA I/O 80042051 OI CTFLG1,CTERROR SET UP ERROR REC SW 80042651 SPACE 80044051 * THE D.A. RECORD FORMAT AT THIS TIME IS AS FOLLOWS: SEEK,SRCH,TIC, * 80045051 * READ, READ, SEARCH ADDRESS. THE SEARCH ADDRESS IS BUMPED IN ORDER* 80046051 * TO ALLOW A READ OF THE PRECURSOR RECORD AS RECORD N+2 WHERE N IS * 80047051 * THE RECORD NUMBER OF THE WORK RECORD. * 80048051 SPACE 80049051 IC WORKREG1,CTCCHHR+6 .GET IPL CCHHR 80050051 LA WORKREG1,1(WORKREG1) BUMP BY 1 FOR PRO RCD 80052051 STC WORKREG1,CTCCHHR+6 STORE IT BACK IN CCT 80054051 MVI READWK+4,HEX20 SET UP NO CMD CHAIN 80056051 MVI READWK+2,HEX78 SET ADDR IN STORAGE TO X'7800' 80058051 LH IODEVREG,CTINADDR .SET UP FOR I/O TO IPL DEV 80060051 LA CCWREG,SEEKWK SET UP THE CCWS 80062051 LA RETREG,GETPROIO CONTINUE AT GETPROIO @ZA17663 80070051 B DUMPSIO DO I/O TO GET PRECURSOR @ZA17663 80080051 AGO .EQUATES 80100051 .CALLPGE ANOP 80130051 B PGEISIN 80160051 .* MACRO SECTION 17 @ZA27964 80190051 .EQUATES ANOP 80197051 AIF ('&IPL2'(1,1) EQ 'T').NODA IF IPL FROM TAPE, SKIP DA 80204051 ********************************************************************** 80220551 * * 80221051 * THIS CODE CONTAINS THE COMMON D.A. ERROR RECOVERY SUBSET * 80221551 * * 80222051 ********************************************************************** 80222551 SPACE 80223051 DARETRY DS 0H DA RETRY ROUTINE 80224051 TM SENSE14,X'08' NO RECORD FOUND COND 80225051 BO ERRMSG ERROR, MSG AND WAIT STATE 80226051 TM SENSE07,X'01' SEEK CHECK COND 80227051 BO ERRMSG ERROR, MSG AND EXIT 80228051 TM SENSE01,HEX40 INTERVENTION REQUIRED COND 80229051 AIF ('&TYPE2' EQ 'HI').HIDAWK 80230051 BNO DATRYA ON ALL OTHER CASES RETRY 16 TIMES 80231051 .HIDAWK ANOP 80232051 BO IPLINTV GO TO INTV REQ 80233051 TM SENSE06,X'02' TRK CONDITION CHECK ? 80234051 BNO DATRYA RETRY 16 TIMES ON OTHER CASES 80235051 AIF ('&TYPE2' EQ 'LO').SKIPLO @ZA24157 80236051 XC ALTCCHHR(12),ALTCCHHR .ZERO ALT TRK INPUT AREA 80237051 OI CTFLG1,CTERROR SET NO ERROR REC SW 80238051 LA CCWREG,ERRSEEK SET UP FOR OBTAINING ALT TRK 80239051 BAL RETREG,DUMPSIO GO ISSUE ERROR SEEK 80240051 TM CTFLG1,CTERROR DID ERROR OCCUR ? 80241051 BNO WKFLDONE YES, NO MORE WORK FILE 80242051 TM ALTCCHHR,X'02' DEFECTIVE TRACK 80243051 BNO WKFLDONE NO, NO MORE WORK FILE 80244051 LA CCWREG,SEEKSA SET UP TO SEEK TO ALT TRK, 80245051 BAL RETREG,DUMPSIO AND SEARCH TO ORIGINAL 80246051 TM CTFLG1,CTERROR ERROR OCCUR ? 80247051 BNO WKFLDONE YES, NO MORE WORK FILE 80248051 .SKIPLO ANOP @ZA24157 80249051 NI CTFLG1,HEXFF-CTERROR .TURN OFF ERROR SW 80250051 SR RETCODE,RETCODE ZERO RETURN CODE 80251051 LR RETREG,WORKREG3 RESTORE CALLERS REGISTER 80252051 BR RETREG RETURN TO CALLER 80253051 IPLINTV DS 0H IPL INTV REQUIRED CODE 80254051 MVC MSG14I+13(3),IPLMSG SET UP IPL DEV MSG 80255051 MVI LMSG14I,HEX14 SET PROPER MSG LENGTH 80256051 B INTVR2 RETRY THE I/O OPERATION AFTER MSG 80257051 DATRYA DS 0H DA RETRY CODE 80258051 L ERROREG,CTERBDA OBTAIN THE DA RETRY CTR 80259051 LTR ERROREG,ERROREG RETRY IN PROCESS? 80260051 BNZ DARETRY1 YES, SET RETRY 80261051 LA ERROREG,17 NO, INIT RETRY CTR 80262051 DARETRY1 DS 0H 16 RETRY CODE 80263051 LA CCWREG,SEEKWK RESTORE THE WORK CCW FROM START 80264051 BCT ERROREG,DARESIO DEC CTR, AND RETRY OPER 80265051 MVI ENDUP1+1,HEXF0 TURN OFF EXIT SW FOR PERM ERR 80266051 B ERRMSG EXIT AND WAIT STATE COND 80267051 DARESIO DS 0H 80268051 ST ERROREG,CTERBDA SAVE RETRY CTR 80269051 B DUMPSIO RETRY THE OPERATION 80270051 .NODA ANOP SKIP DA ERROR RECOVERY @ZA24157 80271051 EJECT 80272051 ********************************************************************** 80280051 * * 80310051 * THIS SECTION CONTAINS THE REGISTER EQUATES FOR THE PROGRAM * 80340051 * * 80370051 ********************************************************************** 80400051 SPACE 80430051 SAVREG EQU 0 TEMPORARY SAVE REGISTER 80460051 LOOPCTR EQU 1 PROTECTION KEY CTR REG 80480051 TIOREG EQU 1 RETURN REG FOR TIOLOOP RTN @ZA56338 80490000 STORADDR EQU 2 CURRENT ADDR OF BLOCK PROCESSED 80500051 STORWORK EQU 3 ADDR OF BLOCK WRITTEN FROM 80520051 KEYREG EQU 4 WORKREG FOR STORAGE KEY 80540051 ERROREG EQU 4 ERROR RECOVERY REG FOR ERB 80560051 LINEREG EQU 4 OUTPUT LINE POSITION 80580051 INREG EQU 5 WORKREG INPUT PROCESSING FROM OPER 80600051 WORKREG1 EQU 5 WORK REG FOR CONVERSION/FORMAT RTN 80620051 OUTREG EQU 6 WORKREG OUTPUT PROCESSING FROM OPER 80640051 WORKREG2 EQU 6 WORKREG TO CONTAIN DEV ADDR 80660051 INCREG EQU 6 INCREMENT REG ON BXLE 80680051 LIMITREG EQU 7 LIMIT ON BXLE 80700051 WORKREG3 EQU 7 CONVERTED DEV ADDR REG 80720051 DUPREG EQU 7 DUPLICATE LINE REG 80740051 LOOPREG1 EQU 7 OUTER CTR CONTROL 80760051 BUFFREG EQU 8 BUFFER REGISTER PTR 80780051 LOOPREG2 EQU 8 INNER LOOP CTL ON CONVERT 80800051 WORKREG4 EQU 8 REG INDICATING CHAR TO CONVERT 80820051 MSGREG EQU 9 MESSAGE REGISTER IF ERROR OCCURS 80840051 IODEVREG EQU 10 DEVICE TO PERFORM SIO ON 80860051 CCWREG EQU 11 CCW'S TO EXECUTE SIO FOR 80880051 BASEREG EQU 12 THIS IS THE PROGRAM BASE REGISTER 80900051 CCTREG EQU 12 BASE REG FOR CCT 80920051 RETREG EQU 13 RETURN REGISTER 80940051 CREG EQU 14 THIS REG IS USED TO BALR TO SIO RTN 80960051 RETCODE EQU 15 RETURN CODE REGISTER 80980051 EJECT 81000051 ********************************************************************** 81270051 * * 81300051 * THIS SECTION DEFINES THE CONSTANTS USED IN THE PROGRAM * 81330051 * * 81360051 ********************************************************************** 81390051 SPACE 81420051 MSGHDLEN EQU 11 MSG HEADER LENGTH 81450051 TITLEN EQU 100 TITLE LENGTH 81500051 AIF ('&TYPE2' EQ 'LO').LENGTH1 TYPE LOW WRITES 121 BYTE RCDS 81550051 DUMPLNGH EQU 4096 LENGTH OF DUMP RCD 81600051 TAPEWREC EQU 24576 24K WORK RECORD ON TAPE 81650051 AGO .VARCONS PICK UP ALL VARIABLES 81700051 .LENGTH1 ANOP LOW SPEED DUMP LENGTH 81750051 DUMPLNGH EQU 121 SET UP FOR 121 BYTE OUTPUT RCD 81800051 .VARCONS ANOP VARIABLES 81850051 EJECT 81900051 ********************************************************************** 82560051 * * 82590051 * THIS SECTION CONTAINS THE VARIABLE CONSTANTS FOR THE PROGRAM * 82620051 * * 82650051 ********************************************************************** 82680051 SPACE 82710051 FLCMCNP EQU X'70',8 MCHK NEW PSW LOCATION @ZA27964 82728000 FLCMCOP EQU X'30',8 MCHK OLD PSW LOCATION @ZA27964 82746000 FLCINPSW EQU X'78',8 I/O NEW PSW @ZA56338 82764000 CSW EQU X'40',8 LOCATION OF CSW IN PERMANENT STORAGE 82782000 CAPS EQU X'40' MAKE ALL INPUT CAPITAL LETTERS 82800051 CAW EQU X'48' CHANNEL ADDRESS WORD IN PERM STORAGE 82820051 IOADDR EQU 186 LOCATION OF I/O DEV ADDR IN STORAGE 82840051 LOWCORE1 EQU 8 LOW STORAGE SAVE AREA 82860051 LOWCORE2 EQU 6 LOW STORAGE SAVE AREA FOR CSW 82880051 LOCORE14 EQU 14 RET CODE SAVE AREA 82900051 GPRLOC EQU 384 LOCATION IN PS OF GPR 82920051 CRLOC EQU 448 LOCATION IN PS OF CR 82940051 CR1LOC EQU CRLOC+4 CR1 LOCATION 82960051 PSASTOR EQU X'31C' PSA LOCATION 82980051 CR1ALOC EQU PSASTOR CR1 ALTERNATE LOC 83000051 STSTGPRS EQU X'180' LOC OF STORE STAT REGS 83020051 FPLOC1 EQU 352 LOCATION IN PS OF FP 0&2 83040051 FPLOC2 EQU 368 LOCATION IN PS OF FP 4&6 83060051 CURRPSW EQU 256 LOCATION IN PS OF CURRENT PSW 83080051 PRADDR EQU 264 LOCATION OF PREFIX REG IN PS 83100051 PGMNEW EQU X'68' LOCATION OF PGM CHECK NEW PSW IN STORAGE 83120051 PGMOLD EQU 40 PGM OLD PSW 83140051 EXTOLD EQU X'18' EXTERNAL OLD PSW 83160051 EXTNEW EQU X'58' EXTERNAL NEW PSW 83180051 IOOLD EQU X'38' I/O OLD PSW 83200051 IOINTDEV EQU X'BA' IPL LOCATION @ZA56338 83230000 TRTABLE EQU 384 TRT TABLE IN LO STORAGE 83260051 IPLCCHHR EQU X'134' IPL CCHHR LOCATION 83280051 ADDRSAVE EQU SAVECSW+8 SAVE AREA FOR ADDR IN CONVERT 83300051 DUPSW EQU CTFLG2 DUPSW IS DUPLICATION LINE BIT 2 83320051 BLANK EQU C' ' EBCDIC BLANK 83340051 WORK EQU SAVECSW+3 OVERLAY INIT AREA WITH WORK AREA 83360051 DECIMAL EQU X'F0' DECIMAL DIGIT PREFIX 83380051 ASK EQU C'*' CHAR * FOR FORMAT BUFFER 83400051 COMMA EQU X'6B' COMMA 83420051 A EQU C'A' LETTER A 83440051 F EQU C'F' LETTER F 83460051 R EQU C'R' LETTER R 83480051 V EQU C'V' LETTER V 83500051 NOP EQU X'00' USED TO CHANGE BRANCH INST 83520051 AIF ('&OUTPUT2'(1,1) EQ 'P').ERB1 FOR PTR SKIP TAPE ERB 83540051 ERBRETRY EQU CTERBTPE+3 ERB RETRY BYTE 83560051 ERBID EQU CTERBTPE ERB IDENTIFICATION BYTE 83580051 ERBCTRP EQU CTERBTPE+2 ERB PRIMARY RETRY BYTE 83600051 ERBCTRS EQU CTERBTPE+2 ERB SECONDARY RETRY BYTE 83620051 .ERB1 ANOP DEFINE WORKAREA 83640051 WORKAREA EQU X'1000' AREA INTO WHICH WORK RECORD WILL 83660051 * BE READ 83680051 LOOPCT EQU 64 LOOP COUNTER 83700051 REALNGTH EQU X'800' LENGTH OF REAL DUMP 83720051 RPPLNGTH EQU X'6000' REAL,PAGE,PRECURSOR LENGTH 83740051 IPLNGTH EQU 24 LENGTH OF IPL 1 83760051 DAREAD EQU X'06' DA READ COMMAND 83780051 SRCHCCW EQU X'31' SEARCH CCW ON DA 83800051 SRCHLNGH EQU 5 SEARCH LENGTH 83820051 DAWRITE EQU X'05' DA WRITE COMMAND 83840051 WORKCCW1 EQU 272 START OF DA WORK CCW'S 83860051 WORKREAD EQU X'148' WORK READ COMMAND LOC 83880051 WORKWRTE EQU X'140' WORK WRITE COMMAND LOC 83900051 WORKID EQU X'15A' WORK SEARCH ADDR LOC 83920051 IOWAIT EQU 4 IO WAIT STATE CMD 83940051 AIF ('&TYPE2' EQ 'LO').SKIP 83960051 PGMSAVE EQU DUMPTITL FOR SAVING PSW'S 83980051 .SKIP ANOP 84000051 EJECT 84020051 ********************************************************************** 84660051 * * 84690051 * THIS SECTION CONTAINS THE MASKS USED TO TEST VARIABLES IN THE PGM * 84720051 * * 84750051 ********************************************************************** 84780051 SPACE 84810051 SPACE1 EQU X'0B' SPACE 1 LINE IMMED COMMAND 84840051 PROLDERR EQU X'0D' WAIT CODE ERROR LOADING PRO 84870051 WRCKD EQU X'1D' WRITE COUNT KEY DATA 84900051 HEX1F EQU X'1F' WTM COMMAND CODE 84930051 HEXFF EQU X'FF' FOR DEV ADDR TR 84960051 HEX07 EQU X'07' GRAPHICS CCW 84990051 HEX09 EQU X'09' REWIND COMMAND CODE 85020051 HEX10 EQU X'10' EQUIPMENT CHECK STATUS 85050051 HEX11 EQU X'11' PTR WRITE SPACE 2 AFTER PNT 85080051 HEX12 EQU X'12' 85110051 HEX14 EQU X'14' USED FOR IPL DEV MSG LENGTH 85140051 HEX16 EQU X'16' READ RCD 0 CMD 85170051 HEX17 EQU X'17' ERG COMMAND CODE 85200051 HEX1A EQU X'1A' READ HOME ADDR CMD 85230051 HEX20 EQU X'20' CONSTANT TO ALTER FLAG BITS IN CCW 85260051 HEX24 EQU X'24' FLAG BIT FOR SLI AND IDA IN CCW 85290051 AIF ('&OUTPUT2'(1,1) NE 'P').HEX27 @Z40MI3F 85320051 * OR SENSE ERROR LOG FULL CMD @Z40MI3F 85350051 .HEX27 ANOP @Z40MI3F 85380051 HEX27 EQU X'27' FOR BUFFER READ CCW 85410051 HEX30 EQU X'30' NO DATA XFER 85440051 HEX31 EQU X'31' SEARCH CMD 85470051 HEX37 EQU X'37' TAPE FORWARD SPACE BLOCK COMMAND 85500051 AIF ('&OUTPUT2'(1,1) NE 'P').HEX40 @Z40MI3F 85530051 * OR INITIALIZE PRINTER CMD @Z40MI3F 85560051 .HEX40 ANOP @Z40MI3F 85590051 HEX40 EQU X'40' INCORRECT LENGTH COMPARE 85620051 HEX58 EQU X'58' LENGTH COUNTER 85650051 HEX70 EQU X'70' COMMAND CHAIN NO DATA XFER 85680051 HEX78 EQU X'78' ENTRY POINT OF PRECURSOR ROUTINE 85710051 HEX7F EQU X'7F' FOR RESTORE OF ERRFLG 85740051 HEX80 EQU X'80' SETTING FOR CTERRFLG 85770051 HEX82 EQU X'82' SETTING FOR ATTNQ AND UNIT CHK COND 85800051 HEX88 EQU X'88' CTERROR,CTMORTPE SWITCH 85830051 HEX8B EQU X'8B' PTR SKIP TO CHAN 9 COMMAND 85860051 HEX93 EQU X'93' 7 TRK MODE SET 85890051 HEX1 EQU B'0001' CPUID MASK 85920051 HEX3 EQU B'0011' ADDRESS MASK 85950051 HEX7 EQU B'0111' ADDRESS MASK 85980051 HEX8 EQU B'1000' DATA MASK 86010051 HEXC EQU B'1100' MASK FOR FIRST TWO BYTES OF REG 86040051 HEXF EQU B'1111' FOR FULL WORD STORE CHAR MASK 86070051 HEXA0 EQU X'A0' DATA CHAINING CMD-TAPE 86100051 HEXAF EQU X'AF' MASK TO RESET DA I/O 86130051 HEXB3 EQU X'B3' 7 TRACK TAPE MODESET 86160051 HEXBF EQU X'BF' MASK TO RESET DA I/O 86220051 HEXC0 EQU X'C0' ALPHNUMBERIC CHAR COMPARE BYTE 86250051 HEXDF EQU X'DF' DUPLICATE SWITCH ON-OFF 86280051 HEXC3 EQU X'C3' 9 TRACK TAPE MODESET 86310051 HEXD3 EQU X'D3' 6250BPI MODESET @ZA04267 86340051 HEXE0 EQU X'E0' PTR SEVERE ERROR COND 86370051 HEXF0 EQU X'F0' USED FOR CHANGING TAPESW NOP TO BC 15 86400051 HEXF7 EQU X'F7' END OF REEL SWITCH PROCESSING 86430051 HEXFD EQU X'FD' WORK RECORD RESET FLAGS 86460051 HEXFE EQU X'FE' FOR RESET OF STORAGE KEY BIT 86490051 HIMASK EQU X'80' USED FOR HIGH ORDER BYTE OF REG 86520051 MASK12 EQU X'C0' USED FOR FIRST HALF OF REG 86550051 HEX3F EQU X'3F' CHECK FOR CATASTROPHIC CHANNEL ERROR 86580051 SKIPSP1 EQU X'F0' TAPE SPACE CONTROL SWITCH 86610051 TPRECLEN EQU X'6000' RCD LENGTH 24K 86640051 HEX800 EQU X'800' ADDRESS INCREMENT 86670051 * COMMON I/O EQUATES 86700051 TICMD EQU X'08' TIC COMMAND 86730051 SENSECMD EQU X'04' SENSE COMMAND CODE 86760051 NODATA EQU X'B0' NO DATA TRANSFERRED 86790051 .COMCONS ANOP COMMON CONSTANTS 86820051 EJECT 86850051 ********************************************************************** 87120051 * * 87150051 * THESE ARE THE DC CONSTANTS * 87180051 * * 87210051 ********************************************************************** 87240051 SPACE 87270051 DS 0H SET UP XC ON HALFWORD BOUNDRY 87300051 AIF ('&TYPE2' EQ 'LO').LESSERC SKIP BUS CK ERB'S 87330051 STARTADR DC A(0-4096) INIT ADDR FOR REAL DUMP 87360051 INCRBLKS DC F'4096' INCREMENT IN 4K BLKS FOR DUMP 87390051 SAVERET1 EQU DUMPTITL+8 TEMP SAVE FOR RETREG 87420051 SAVERET2 EQU DUMPTITL+4 TEMP SAVE FOR RETREG 87450051 AIF ('&IPL2'(1,1) EQ 'T').NODAWK 87480051 DEVSAVE DS F'0' FOR ADDR OF DEV TYPE 87510051 CCHHW DS F'0' WORKFILE CCHH 87540051 TABLNG DS 0H SET UP TABLE 87570051 D2305A DC H'48' TRK CAPACITY ON 2305-1 87600051 DC H'08' TRKS PER CYLINDER 87630051 DC H'06' DEVICE ID 87660051 DC H'02' RCD PER TRK COUNT -1 87690051 D2305B DC H'96' TRK CAPACITY ON 2305-2 87720051 DC H'08' TRKS PER CYLINDER 87750051 DC H'07' DEVICE ID 87780051 DC H'02' RCD PER TRK COUNT -1 87810051 D3330 DC H'411' 3330 TRK CAPACITY 87840051 DC H'19' TRKS PER CYLINDER 87870051 DC H'09' 3330 ID 87900051 DC H'02' RCD PER TRK COUNT -1 87930051 D2314 DC H'203' TRK CAPACITY ON 2314 87960051 DC H'20' TRKS PER CYLINDER 87990051 DC H'08' 2314 ID 88020051 DC H'00' RCD PER TRK COUNT -1 88050051 D3330A DC H'815' 3330-1 TRK CAPACITY 88080051 DC H'19' TRKS PER CYLINDER 88110051 DC H'13' 3330-1 ID 88140051 DC H'02' RCD PER TRK COUNT -1 88170051 D3340A1 DC H'349' 3340A2 TRK CAPACITY 88200051 DC H'12' TRKS PER CYLINDER 88230051 DC H'10' 3340 ID 88260051 DC H'01' RCD PER TRK COUNT -1 88290051 D3340A2 DC H'698' 3340A3 TRK CAPACITY 88320051 DC H'12' TRKS PER CYLINDER 88350051 DC H'10' 3340 ID 88380051 DC H'01' RCD PER TRK COUNT -1 88410051 D3350 DC H'560' 3350 TRACK CAPACITY @Z30RSTA 88440051 DC H'30' TRKS PER CYLINDER @Z30RSTA 88470051 DC H'11' 3350 ID @Z30RSTA 88500051 DC H'03' RCD PER TRK COUNT -1 @Z30RSTA 88530051 TABEND DC XL1'FF' END OF TABLE 88560051 ENDTAB EQU X'FF' END OF TABLE MASK 88590051 WKRCDCCW CCW HEX07,SEEKADDR,X'60',6 SEEK COMMAND 88620051 READHA CCW HEX1A,DUMPTITL,HEX70,5 READ HOME ADDR 88650051 WKRCDSR CCW HEX31,SEEKADDR+2,X'60',5 SEARCH COMMAND 88680051 CCW X'08',WKRCDSR,X'60',1 .TIC TO SEARCH 88710051 WKRCDWRT CCW WRCKD,IDAWORD,HEX24,DUMPLNGH+8 WRITE WK FILE RCD 88740051 ERRSEEK CCW HEX07,SEEKADDR,X'60',6 SEEK TO DEF TRK 88770051 CCW HEX1A,ALTCCHHR,X'60',5 READ HOME ADDR OF DEF TRK 88800051 CCW HEX16,ALTCCHHR+8,HEX20,4 READ RCD 0 FROM DEF TRK 88830051 SEEKSA CCW HEX07,ALTCCHHR+6,X'60',6 SEEK TO ALT TRK 88860051 CCW X'08',READHA,X'60',1 TIC TO READ HOME ADDR 88890051 ALTCCHHR DC 3F'0' ALT TRK CCHHR LOC 88920051 SEEKADDR DC 2F'0' SEEK ADDR FOR WKFILE 88950051 DS 0F 88980051 IDAWORD DC XL4'7FF8' ADDRESS OF COUNT PORTION 89010051 IDAWORD1 DC F'0' ADDRESS OF 1ST 2K BLOCK 89040051 IDAWORD2 DC F'0' ADDRESS OF 2ND 2K BLOCK 89070051 .NODAWK ANOP 89100051 .LESSERC ANOP EOJ DEFINITION 89130051 AIF ('&TYPE2' EQ 'HI').LSE10 FOR HI USE DIFFERENT ERB CTR 89160051 OVERUNTP DC XL4'050005FF' FIVE RETRY ERB 89190051 DATCKTPE DC XL4'150010FF' FIFTEEN RETRY ERB 89220051 KEYSAVE DC XL2'FFFF' STORAGE KEY SAVE AREA 89250051 H32 DC H'32' 32 TO BUMP STORWORK 89280051 SWITCH DC XL1'00' SWITCH 89310051 ADDCNVRT EQU X'80' ADDR= CONVERT 89340051 TIME2 EQU X'40' SECOND CONVERT TIME 89370051 FOURKDWN DC XL2'F000' TO ROUND DOWN TO 4K BDY 89400051 ADDAREA1 EQU CTADDRS+1 ADDR= RESPONSE AREA 89430051 ADDAREA2 EQU CTADDRE+1 ADDR= RESPONSE AREA 89460051 DS 0F 89490051 CR0INIT DC XL4'00800000' TO INIT CR 0 89520051 CPUADDR DC XL2'0000' CPU ADDRESS 89550051 REQCHAR DC CL1'R' DUMP ID CHARACTER 89580051 .LSE10 ANOP EOJ DEFINITION 89610051 TEMPSAVE DC F'0' TEMP REG SAVE AREA 89640051 EOJSW DC XL5'000C000000' PGM NEW, EC MODE & MCHK @ZA27964 89670051 EOJSW1 DC AL3(PGMCHK) ADDR OF PGM CHECK RTN 89700051 KNINE DC H'9' FOR CONVERT FROM EBCDIC TO BINARY 89730051 WORKSTRT DC XL2'7000' WORK RECORD LOCATION 89760051 STAPSW DC XL5'0008000000' 89790051 DC AL3(NOMP) PSW FOR STAP INST 89820051 HALTPSW DS 0D FINAL WAIT PSW 89850051 DC X'000A000000000000' 89880051 ALTPSW DS 0D ALTERNATE CONSOLE PSW 89910051 DC XL8'030A0000000000FF' .ALT CONSOLE PSW 89940051 ALTEXPSW DC XL5'0008000000' 89970051 AEXTINT DC AL3(EXTINT) ALT CONSOLE EXTERN INT ADDR 90000051 ALTIOPSW DC XL5'0008000000' I/O INT PSW 90030051 AIOINT DC AL3(IOINT) ALT CONSOLE I/O INT ADDR 90060051 DS 0F 90090051 HIGHEST DC XL4'01000000' HIGHEST STORAGE ADDR 90120051 COREBOX DC XL4'00040000' AMT OF STORAGE PER COREBOX 90150051 FOURK DC XL2'1000' LENGTH OF A 4K RECORD 90180051 MAXCORE EQU X'01' MAX STORAGE ADDRESS 90210051 DS 0H 90240051 MAXCPU EQU X'3F' MAX ALLOWABLE CPU'S 90270051 SIGPSTAT EQU X'09' SIGP CODE 90300051 SIGPSTOP EQU X'05' SIGP CODE 90330051 AIF ('&IPL2'(1,1) EQ 'T').TWK1 TAPE IPL DIFFERENT WORK RCD 90360051 DS 0F SET UP FOR WORK COMPARE 90390051 WORKEND DC XL4'00008000' MAX WORK RECORD SIZE 90420051 AGO .WK3 SKIP TAPE WORK RCD 90450051 .TWK1 ANOP TAPE WORK RCD SIZE 90480051 DS 0F SET UP FOR WORK COMPARE 90510051 WORKEND DC XL4'0000D000' END OF WORK RCD FOR TAPE IPL 90540051 WKSTRT2 EQU WORKEND SECOND WORK RCD 90570051 ENDWKRCD DC XL4'00013000' END OF TAPE WORK RCD 90600051 DS 0H SET UP ON BOUNDRY FOR LH 90630051 .WK3 ANOP 90660051 AIF ('&TYPE2' EQ 'LO').WK2 90690051 ONE28K DC XL4'00020000' 128 K FOR WORK RCD 90720051 .WK2 ANOP COMMON PROCESSING 90750051 WORKADDR DC XL2'1000' WORK ADDR LOCATION 90780051 AIF ('&TYPE2' EQ 'HI').MSG SKIP LOW SPEED CONST FOR HI 90810051 EJECT 90840051 ********************************************************************** 90930051 * * 90960051 * CONSTANTS FOR LOW SPEED REAL DUMP ONLY. THIS INCLUDES TRANSLATE * 90990051 * TABLES AND PRINTER CODE (NOT THE CHANNEL PROGRAMS) FOR LOW SPEED * 91020051 * * 91050051 ********************************************************************** 91080051 SPACE 91110051 REGSAVE DC F'0' REG SAVE AREA FOR R14 91140051 SAVEDUP DC F'0' DUP LINE ADDR SAVE AREA 91160051 LOWCOREA DC H'64' FOR CSW AND CAW RESTORE 91180051 DS 0F 91200051 OUTCTL DC XL1'F1' CARRIAGE CONTROL CHAR 91220051 OUTLINE DC CL11'DUMP TITLE ' .HEX LINE CONVERT 91240051 OUTDATA DC CL75' ' OUTPUT DATA FIELD 91260051 OUTASK1 DC CL1' ' DELIMITER FOR FORMATTED EBCDIC SECT 91280051 FORMBUF DC CL32' ' FORMATTED HEX 91300051 OUTASK2 DC CL1' ' END OF FORMATTED EBCDIC SECTION 91320051 TRANLATE DC C'.ABCDEFGHI......' TRANSLATE TABLE FOR CONVERT OF 91440051 DC C'.JKLMNOPQR......' HEXADECIMAL CONSTANTS TO 91470051 DC C'..STUVWXYZ......' EBCDIC CHARACTERS ON RHS OF PAGE 91500051 DC C'0123456789......' NUMBER CONVERSIONS 91530051 DC C' ' BLANK CHAR CONVERSION 91560051 HEXTAB DC C'0123456789ABCDEF' HEX TRANSLATION TABLE 91580051 HEADLNGH EQU OUTDATA+68 SET HEADING TITLE IN OUTPUT LINE 91600051 DUMPRCD EQU OUTCTL SET UP OUTPUT LINE 91620051 DUMPTITL EQU OUTDATA TITLE AND SAVE AREA 91640051 VIRTAREA EQU DUMPTITL INPUT FOR ADDR= RESPONSE 91660051 SAVERET1 EQU DUMPTITL+8 TEMP SAVE FOR RETREG 91680051 SAVERET2 EQU DUMPTITL+4 TEMP SAVE FOR RETREG 91700051 PGMSAVE DC 4F'0' PSW SAVE AREA 91720051 REALADDR EQU DUMPRCD FOR TAPE CCW 91740051 .MSG ANOP MESSAGES 91760051 EJECT 91780051 ********************************************************************** 91920051 * * 91950051 * THIS SECTION CONTAINS THE MESSAGES USED BY AMDSADMP * 91980051 * * 92010051 ********************************************************************** 92040051 SPACE 92070051 MSG11D DC C'11A TITLE=' FOR THE DUMP TITLE REQUEST 92100051 LMSG11D DC XL1'0A' LENGTH OF MSG11D MSG 92106051 ORG MSG11D USE MSG11 TEXT FOR SAVE AREA @ZA56338 92107200 LCSAVE DS F SAVEAREA FOR LOOPCTR @ZA56338 92108400 ORG 92109600 SPACE 1 @ZA56338 92110800 MSG05I DC C'05I REAL DUMP DONE' NORMAL ENDING MESSAGE 92112051 LMSG05I DC XL1'12' LENGTH OF MSG05I 92118051 IPLMSG DC C'IPL' INTERVENTION REQ ON IPL DEV 92124051 SPACE 92130051 CONSCODE EQU MSG21I INVALID CONSOLE ADDR MSG 92136051 ENDMSG EQU MSG05I NORMAL ENDING MESSAGE 92142051 L3 DC X'03' DEVICE LENGTH 92148051 L14 DC XL1'0E' ADDR REPLY LENGTH 92154051 L100 DC XL1'64' TITLE LENGTH 92160051 AIF ('&TYPE2' EQ 'HI').MSG1 SKIP FOR HI SPEED DUMP 92166051 MSG09I DC C'09I CR1 INVALID' 92172051 LMSG09I DC XL1'0F' MSG LENGTH 92178051 MSG08A DC C'08A ADDR=' ADDR RANGE REQUEST 92184051 LMSG08A DC XL1'09' LENGTH OF MSG 08A 92190051 PSWMSG DC C'CURRENT PSW' CURRENT PSW MSG 92196051 KEYMSG DC C'STORAGE KEY' STORAGE PROTECTION KEY MSG 92202051 PRMSG DC C'PR' PREFIX REG MSG 92208051 CPUIDMSG DC C'CPU ID' CPU ID RECORD HEADER 92214051 GR07 DC C'GR 0-7' GR MSG 92220051 GR8F DC C'8-F' GR MSG 92226051 CR07 DC C'CR 0-7' CR MSG 92232051 CR8F EQU GR8F CR 8-F MSG 92238051 FR02 DC C'FR 0-2' FP REG MSG 92244051 FR46 DC C'4-6' FP REG MSG 92250051 .MSG1 ANOP COMMON MSG AREA 92256051 AIF ('&OUTPUT2'(1,1) EQ 'P').MSG2 IF PTR SPECIAL MSG 92262051 MSG1A DC C'01A TAPE=' INPUT REQUEST FROM TAPE 92268051 AGO .MSG3 SKIP PTR MSG 92274051 .MSG2 ANOP PTR MSG 92280051 LMSG1A DC XL1'8' LENGTH OF THE MSG1A MSG 92286051 MSG1A DC C'01A PTR=' INPUT REQUEST LOW SPEED FROM PTR 92292051 .MSG3 ANOP COMPLETION OF MSG 92298051 EJECT 92304051 *********************************************************************** 92310051 * * 92316051 * MACHINE CHECK HANDLER, DATA, AND DATA AREAS FOR SKIPPING OVER PAGE * 92322051 * FRAMES WITH POSSIBLE STORAGE CHECKS PRIOR TO INITIATING I/O * 92328051 * @ZA27964* 92334051 *********************************************************************** 92339051 MCHKFLG DC AL1(0) FLAG BYTE FOR MACH CHK @ZA27964 92344051 MCHKPE EQU X'40' ON INDICATES THAT THE MACH CHK 92349051 * HANDLER IS SET UP @ZA27964 92354051 MCHKOK EQU X'80' ON INDICATES THAT THE FRAME ABOUT TO 92359051 * BE DUMPED IS BEING TESTED TO SEE 92364051 * IF IT WILL CAUSE A STOR CHK @ZA27964 92369051 MCHKSK EQU X'20' ON INDICATES THAT THE STOR KEY IS 92374051 * BEING OBTAINED AND IF IT IS BAD A 92379051 * PHONIE ONE SHOULD BE USED @ZA27964 92384051 MCHKCNT DC H'-13' COUNT OF UNEXPECTED MCHK. WHEN IT 92389051 * REACHES 0 LOAD A WAIT PSW @ZA27964 92394051 MCHKWAIT EQU X'32' WAIT STATE CODE USED WHEN AN EXCESS 92399000 * OF UNEXPECTED MCHK OCCURR @ZA27964 92404051 MCHKNPSW DS 0D MACH CHK NEW PSW @ZA27964 92409051 DC XL5'000C000000' EC MODE & MCHK @ZA27964 92414051 DC AL3(MCHKHNDL) MACH CHK HANDLER @ZA27964 92419051 MCHKENBL DS 0D PSW TO ENABLE FOR MACH CHKS @ZA27964 92424051 DC XL5'000C000000' EC MODE & MCHK @ZA27964 92429051 AIF ('&TYPE2' EQ 'HI').HIPSW BRANCH ADDR DIFFERENT @ZA27964 92434051 DC AL3(PAST1000) NEXT SEQ INST @ZA27964 92439051 AGO .LOPSW @ZA27964 92444051 .HIPSW ANOP @ZA27964 92449051 DC AL3(TAPEGOT) NEXT SEQ INST @ZA27964 92454051 .LOPSW ANOP @ZA27964 92459051 MCHKDSBL DS 0D PSW TO DISABLE FOR MCHK @ZA27964 92464051 DC XL5'0008000000' EC MODE @ZA27964 92469051 DC AL3(MCHKOUT) NEXT SEQ INST @ZA27964 92474051 MCHKCR14 DC X'00000000' MASK ALL LOGOUTS @ZA27964 92479051 AIF ('&MCHK' EQ '').MTST002 @ZA27964 92484051 * THE FOLLOWING CONSTANTS AND CODE ARE EXPANDED IF MCHK^= NULL 92520051 * ON THE MACRO. THE FUNCTION IS TO SET BAD ECC AT THE STORAGE LOCATIONS 92526051 * LISTED BELOW. THIS IS DONE USING THE DIAGNOSE INST TO STORE DATA 92532051 * WITHOUT UPDATING THE ECC (OR CHECK BYTE). IT IS INTENDED FOR USE 92538051 * ON A 370/158 @ZA27964 92544051 MCHKSAVE DS 16F SAVEAREA @ZA27964 92549051 AIF ('&MCHK' NE '158').MTST009 @ZA27964 92554051 MCHKDG1 DC X'0100D100' SHUT OFF THE HARDWARE HIGH SPEED 92559051 * BUFFER @ZA27964 92564051 MCHKDG2 DC X'0500D100' STOR OUTWITH ECC UPDATE @ZA27964 92569051 MCHKDG3 DC X'0200D100' TURN ON HIGH SPEED BUFFER @ZA27964 92574051 AGO .MTST010 @ZA27964 92579051 .MTST009 AIF ('&MCHK' NE '168').MTST010 @ZA27964 92584051 MCHKECC DC X'F9B7F9512365F9F9' @ZA27964 92589051 MCHKDG1 DC X'0200001000000000' SHUT OFF THE HARDWARE HIGH SPEED 92594051 * BUFFER @ZA27964 92599051 MCHKDG2 DC X'0300000002000000' TURN OFF ECC UPDATE @ZA27964 92604051 MCHKDG3 DC D'0' CLEAR THE MCW TO RESET CPU @ZA27964 92609051 MCHKDG4 DC X'0300000000000000' TURN ON ECC @ZA27964 92614051 .MTST010 ANOP @ZA27964 92619051 MCHKLOCS DC XL4'2000' THIS FIRST ADDRESS IS THE CRITERIA 92624051 * FOR WHEN TO INSERT THE ERROR @ZA27964 92629051 * THE REST OF THESE ADDRESS ARE DOUBLEWORDS WHERE THE ERROR IS TO BE 92634051 * INSERTED BY THE FOLLOWING LOOP. @ZA27964 92639051 DC XL4'3148' @ZA27964 92644051 DC XL4'4A48' @ZA27964 92649051 DC XL4'5A48' @ZA27964 92654051 DC XL4'5A68' @ZA27964 92659051 DC XL4'5B48' @ZA27964 92664051 MCHKSET C STORADDR,MCHKLOCS TIME TO PUT IN THE ERRORS? @ZA27964 92669051 BL MCHKHOOK+4 NO, KEEP ON RUNNING NORMAL @ZA27964 92674051 NI MCHKHOOK+1,X'00' NOP THE BRANCH TO HERE @ZA27964 92679051 DC X'8300',S(MCHKDG1) SHUT OFF THE HARDWARE HIGH SPEED 92684051 * BUFFER @ZA27964 92689051 STM 0,15,MCHKSAVE @ZA27964 92694051 AIF ('&MCHK' NE '168').MTST004 @ZA27964 92699051 LM 2,3,MCHKECC SETUP VALUE TO STORE WHILE THE ECC 92704051 * IS OFF @ZA27964 92709051 AGO .MTST005 @ZA27964 92714051 .MTST004 AIF ('&MCHK' NE '158').MTST008 @ZA27964 92719051 LA 2,X'F9' SET UP THE DATA TO BE STORED @ZA27964 92724051 SLL 2,24 BY THE DIAGNOSE LATER @ZA27964 92729051 AGO .MTST005 @ZA27964 92734051 .MTST008 ANOP @ZA27964 92739051 MNOTE 12,'MCHK=&MCHK INVALID; TEST CODE IN ERROR' 92744051 .MTST005 ANOP @ZA27964 92749051 LA 15,MCHKLOCS+4 ADDR OF FIRST ERROR LOCATION @ZA27964 92754051 LA 5,MCHKSET SETUP END OF LIST ADDR @ZA27964 92759051 MCHKLOOP L 1,0(15) ERROR LOC IN GPR 1 FOR DIAG @ZA27964 92764051 XC 0(8,1),0(1) ZERO ERROR LOC @ZA27964 92769051 AIF ('&MCHK' NE '158').MTST006 @ZA27964 92774051 LA 1,2(1) USE THIRD BYTE OF ERROR LOC @ZA27964 92779051 DC X'8300',S(MCHKDG2) STOR WITHOUT ECC UPDATE @ZA27964 92784051 AGO .MTST007 @ZA27964 92789051 .MTST006 AIF ('&MCHK' NE '168').MTST007 @ZA27964 92794051 DC X'8300',S(MCHKDG2) TURN OFF THE ECC @ZA27964 92799051 STM 2,3,0(1) STORE INTO THE LOC WHERE A STOR CHK 92804051 * IS DESIRED SO THAT THE ECC AND THE 92809051 * ACTUAL DATA ARE OUT OF SYNC @ZA27964 92814051 DC X'8300',S(MCHKDG4) TURN THE ECC BACK ON AGAIN @ZA27964 92819051 .MTST007 ANOP @ZA27964 92824051 LA 15,4(15) BUMP TO NEXT ERROR LOC @ZA27964 92829051 CR 15,5 CHECK FOR END OF LIST @ZA27964 92834051 BL MCHKLOOP NOT TO END YET @ZA27964 92839051 LM 0,15,MCHKSAVE @ZA27964 92844051 B MCHKHOOK+4 RETURN TO NORMAL PROCESSING @ZA27964 92849051 .MTST002 ANOP @ZA27964 92854051 EJECT 92859051 *********************************************************************** 92864051 * * 92869051 * MACHINE CHECK HANDLER @ZA27964 92874051 * * 92879051 *********************************************************************** 92884051 SPACE 92889051 MCHKHNDL EQU * @ZA27964 92894051 AIF ('&TYPE2' EQ 'HI').DAE003 @ZA27964 92899051 TM MCHKFLG,MCHKOK WAS THIS MCHK EXPECTED ? @ZA27964 92904051 BO SKIPMCHK NO,ASSUME THE ERROR IS DUE TO A STORAGE X92909000 CHECK IN THIS LINE AND SKIP X92914000 TO THE NEXT ONE. @ZA27964 92919000 .DAE003 ANOP @ZA27964 92924051 TM MCHKFLG,MCHKSK WAS ERROR ON AN ISK? @ZA27964 92929051 BO MCHKKEYS YES, CONTINUE DUMPING PAGE @ZA27964 92934051 LA WORKREG1,1 NOT EXPECTED, SO @ZA27964 92939051 AH WORKREG1,MCHKCNT INCR THE UNEXPECTED COUNT @ZA27964 92944051 BC 10,MCHKHALT IF THE LIMIT OF UNNEXPECTED MCHK HAS 92949051 * BEEN REACHED BRANCH @ZA27964 92954051 STH WORKREG1,MCHKCNT OTHERWISE SAVE THE NEW VALUE @ZA27964 92959051 * AND ATTEMPT TO IGNORE THE UNEXPECTED 92964051 * MCHK BY RESTARTING @ZA27964 92969051 B MCHKUNEX ATTEMP TO CONTINUE INSPITE OF THIS 92974051 * UNEXPECTED MACH CHK @ZA27964 92979051 MCHKHALT MVI CTWAIT,MCHKWAIT IF UNEXPECTED MCHK KEEPS HAPPENING 92984051 * THE HARDWARE MUST BE BAD. @ZA27964 92989051 B WAITSTAT SO SET UP A WAITSTATE CODE AND GO 92994051 * INTO A WAIT @ZA27964 92999051 EJECT 93090051 ********************************************************************** 93150051 * * 93180051 * THIS SECTION DEFINES THE SENSE BYTE DEFINATIONS FOR TAPE DEVICES * 93210051 * * 93240051 ********************************************************************** 93270051 SPACE 93300051 SENSAREA EQU CTSENSE SENSE BYTE AREA 93330051 LBLADDR EQU DUMPTITL LABEL INPUT AREA 93360051 SPACE 93390051 * SENSE BYTE 0 93420051 SPACE 93450051 SENSE00 EQU SENSAREA CMD REJECT 93480051 SENSE01 EQU SENSE00 INTERVENTION REQUIRED 93530051 SENSE02 EQU SENSE00 BUS OUT CHECK 93580051 SENSE03 EQU SENSE00 EQUIPMENT CHECK 93630051 SENSE04 EQU SENSE00 DATA CHECK 93680051 SENSE05 EQU SENSE00 OVERRUN CONDITION 93730051 SENSE06 EQU SENSE00 TRACK CONDITION CHECK 93780051 SENSE07 EQU SENSE00 NOT USED 93830051 SPACE 93880051 * SENSE BYTE 1 93930051 SPACE 93980051 SENSE10 EQU SENSAREA+1 NOT USED 94030051 SENSE11 EQU SENSE10 NOT USED 94080051 SENSE12 EQU SENSE10 T U CONDITION 94130051 SENSE13 EQU SENSE10 SEVEN TRACK TAPE 94180051 SENSE14 EQU SENSE10 LOAD POINT 94230051 SENSE15 EQU SENSE10 NOT USED 94280051 SENSE16 EQU SENSE10 NOT USED 94330051 MEND 94380051