TITLE 'IGE0019I - FIRST ERP MODULE FOR THE 2955' 00010000 TITLE 'IGE0019I - FIRST ERP MODULE FOR THE 2955' 00020000 LCLA &T,&SPN 0002 00030000 .@001 ANOP 0002 00040000 IGE0019I CSECT , 0002 00050000 BC 15,24(0,@F) 00060000 DC C'IGE0019I 17 APR 74' 0002 00070000 BALR @B,0 0002 00080000 @PSTART DS 0H 0002 00090000 USING @PSTART+00000,@B 0002 00100000 * R3=R1; /* PARAMETER LIST * 00110000 LR @3,@1 0051 00120000 * R9=IOSERP+'28'X; /* PTR, CCW WORK AREA Y02008* 00130000 LA @F,X'28' 0052 00140000 A @F,52(0,@3) 0052 00150000 LR @9,@F 0052 00160000 * R12=R9+'60'X; /* INIT REG FOR REENT DATA Y02008* 00170000 LA @F,X'60' 0053 00180000 AR @F,@9 0053 00190000 LR @C,@F 0053 00200000 * GEN; 00210000 USING @DATD+00000,@C REENT DATA IN ERPWKAREA Y02008 00220000 XC @TEMPS(@L),@TEMPS CLEAR TEMPORARY AREA Y02008 00230000 DS 0H 00240000 * 00250000 * /* SET IOSB EXCEPTION FLAG AND ERROR FLAG Y02008* 00260000 * 00270000 * IOSEX='1'B; /*SET IOB EXCEPION FLAG Y02008* 00280000 OI 0(@3),B'00100100' 0055 00290000 * IOSERR='1'B; /*SET IOB ERROR FLAG Y02008* 00300000 * 00310000 * /* INITIALIZE DATA AREAS IN CCW WORK AREA Y02008* 00320000 * 00330000 * DAT1DATA='DF'X; /* READ-SKIP DATA BUFR Y02008* 00340000 L @4,52(0,@3) 0057 00350000 MVI 94(@4),X'DF' 0057 00360000 * EOTDATA='1F'X; /* END OF XMISSION CHARY02008* 00370000 MVI 92(@4),X'1F' 0058 00380000 * NEGDATA='40'X; /* NEG RESPONSE DATA Y02008* 00390000 MVI 93(@4),X'40' 0059 00400000 * 00410000 * DAT1=ADDR(DAT1DATA); /* ADDRESS OF RD/SKP Y02008* 00420000 LA @F,94(0,@4) 0060 00430000 ST @F,@TEMP4 0060 00440000 MVC 88(4,@4),@TEMP4 0060 00450000 * EOT=ADDR(EOTDATA); /* ADDRESS OF EOT CHAR Y02008* 00460000 LA @F,92(0,@4) 0061 00470000 ST @F,@TEMP4 0061 00480000 MVC 80(4,@4),@TEMP4 0061 00490000 * NEG=ADDR(NEGDATA); /* ADDRESS OF NEG CHAR Y02008* 00500000 LA @F,93(0,@4) 0062 00510000 ST @F,@TEMP4 0062 00520000 MVC 84(4,@4),@TEMP4 0062 00530000 * 00540000 * /* GET REAL ADDRESSES OF DATA AREAS FOR IOS USE Y02008* 00550000 * 00560000 * R2=DAT1; /* PUT DATA ADD IN REG Y02008* 00570000 MVC @TEMP4(4),88(@4) 0063 00580000 L @2,@TEMP4 0063 00590000 * 00600000 * GEN; 00610000 LRA 2,0(0,2) REAL ADDR OF DAT BUFR Y02008 00620000 BNZ PERR PERM ERR IF XLATE FAIL Y02008 00630000 DS 0H 00640000 * DAT1=R2; /* SAVE REAL ADDRESS Y02008* 00650000 ST @2,@TEMP4 0065 00660000 MVC 88(4,@4),@TEMP4 0065 00670000 * 00680000 * 00690000 * R2=EOT; /* PUT DATA ADD IN REG Y02008* 00700000 MVC @TEMP4(4),80(@4) 0066 00710000 L @2,@TEMP4 0066 00720000 * 00730000 * GEN; 00740000 LRA 2,0(0,2) REAL ADDR OF EOT CHAR Y02008 00750000 BNZ PERR PERM ERR IF XLATE FAIL Y02008 00760000 DS 0H 00770000 * 00780000 * EOT=R2; /* SAVE REAL ADDRESS Y02008* 00790000 ST @2,@TEMP4 0068 00800000 MVC 80(4,@4),@TEMP4 0068 00810000 * 00820000 * R2=NEG; /* PUT DATA ADD IN REG Y02008* 00830000 MVC @TEMP4(4),84(@4) 0069 00840000 L @2,@TEMP4 0069 00850000 * 00860000 * GEN; 00870000 LRA 2,0(0,2) REAL ADDR OF NEG CHAR Y02008 00880000 BNZ PERR PERM ERR IF XLATE FAIL Y02008 00890000 DS 0H 00900000 * 00910000 * NEG=R2; /* SAVE REAL ADDRESS Y02008*/ 00920000 ST @2,@TEMP4 0071 00930000 MVC 84(4,@4),@TEMP4 0071 00940000 * 00950000 * IF TCBRV='0'B /* IF IN VIRTUAL STORAGE Y02008* 00960000 * THEN /* MUST USE VIRT ADDRS Y02008* 00970000 L @4,CVTADPTR 0072 00980000 L @4,0(0,@4) CVTADDR 0072 00990000 MVC @TEMP4(4),328(@4) 0072 01000000 L @4,@TEMP4 CVT 0072 01010000 L @4,28(0,@4) CVTOLTEP 0072 01020000 MVC @TEMP4(4),8(@4) 0072 01030000 L @4,@TEMP4 OLTEPTAB 0072 01040000 TM 202(@4),B'10000000' 0072 01050000 BC 05,@9FF 0072 01060000 * DO; /* TO EXAMINE CCW'S Y02008* 01070000 * 01080000 * R15=CVTPTRV; /* GET ADDR OF XLATE RTN Y02008* 01090000 L @4,CVTADPTR 0074 01100000 L @4,0(0,@4) CVTADDR 0074 01110000 MVC @TEMP4(4),288(@4) 0074 01120000 L @F,@TEMP4 0074 01130000 * R1=IOSRST; /* GET ADDR OF CHAN PROG(REAL) Y02008* 01140000 L @1,72(0,@3) 0075 01150000 * GEN( BALR R14,R15); /* BRANCH TO XLATE RTN Y02008* 01160000 BALR R14,R15 01170000 DS 0H 01180000 * IOSRST=R1; /* PUT XLATED ADDR IN IOSB Y02008* 01190000 ST @1,72(0,@3) 0077 01200000 * R1=R3; /* RESTORE IOSB PTR IN REG 1 Y02008* 01210000 LR @1,@3 0078 01220000 * 01230000 * END; 01240000 * RELEASE(R2); 01250000 * 01260000 * 01270000 * /* SETUP RETRY AND CCW SCAN PTRS BASED ON CSW INFO Y02008* 01280000 * 01290000 * IF IOSCSWCA=0 /* IF CSW CMND ADDR IS Y02008* 01300000 * THEN /* ZERO, MUST CHECK RE-Y02008* 01310000 @9FF CLC 21(3,@3),@D1+1 0081 01320000 BC 07,@9FE 0081 01330000 * R7=IOSRST; /* USE RETRY FOR SCAN Y02008* 01340000 L @7,72(0,@3) 0082 01350000 BC 15,@9FD 0083 01360000 * 01370000 * 01380000 * ELSE /* CSW CMND ADDR ^=0 Y02008* 01390000 * R7=IOSCSWCA-8; /* ADDRESS FAILING CCW Y02008* 01400000 @9FE LH @7,@D2 0083 01410000 MVC @TEMP3+1(3),21(@3) 0083 01420000 A @7,@TEMP3 0083 01430000 * 01440000 * R10=R7; /* SAVE CCW PTR Y02008* 01450000 @9FD LR @A,@7 0084 01460000 * /* CHECK STATUS OF EVENTS, INITIAL OR RETRY OF CCWS Y02008* 01470000 * 01480000 * IF IOBENT='0'B THEN /* IS ENTRY FLAG ON * 01490000 L @2,52(0,@3) 0085 01500000 TM 11(@2),B'10000000' 0085 01510000 * GOTO ERR001; /* NO, NOT FIRST TIME Y02008* 01520000 BC 08,ERR001 0086 01530000 * 01540000 * /* RETRY SITUATION, CHECK RETRY CCW STRING Y02008* 01550000 * 01560000 * IOSMDB=IOSMDB &'00'X; /* ZERO MODIFIER BYTE Y02008* 01570000 NI 90(@3),X'00' 0087 01580000 * R7=IOSRST; /* POINT TO RESTART Y02008* 01590000 L @7,72(0,@3) 0088 01600000 * IF COCO='02'X 01610000 * & SKIP='1'B THEN /* READ SKIP * 01620000 CLI 0(@7),X'02' 0089 01630000 BC 07,@9FC 0089 01640000 TM 4(@7),B'00010000' 0089 01650000 BC 12,@9FB 0089 01660000 * DO; 01670000 * R7=R7+8; 01680000 LA @7,8(0,@7) 0091 01690000 * IOSRST=R7; /* SET UP FAIL CCW Y02008* 01700000 ST @7,72(0,@3) 0092 01710000 * GOTO RETRY1; /* RETRY Y02008* 01720000 BC 15,RETRY1 0093 01730000 * END; 01740000 * 01750000 * R7= R10; /* GET CCW ADDR Y02008* 01760000 @9FB EQU * 0095 01770000 @9FC LR @7,@A 0095 01780000 * IF IOSRST=R7 THEN /* RESTART = FAILING Y02008* 01790000 C @7,72(0,@3) 0096 01800000 * GOTO ERR002; /* YES.BRANCH * 01810000 BC 08,ERR002 0097 01820000 * ERRFLGS1='00'X; /* ZERO FLAGS Y02008* 01830000 L @2,52(0,@3) 0098 01840000 MVI 11(@2),X'00' 0098 01850000 * 01860000 * ERR001: 01870000 * IOBENT='1'B; /* SET ENTRY BIT * 01880000 ERR001 L @2,52(0,@3) 0099 01890000 OI 11(@2),B'11000000' 0099 01900000 * SRS='1'B; /* SET RESTART FLAG * 01910000 * IOSRST=R7; /* RESTART=FAILING CCW Y02008* 01920000 ST @7,72(0,@3) 0101 01930000 * ERR002: 01940000 * R7=IOSVST; /* CHAN PROG ADDR Y02008* 01950000 ERR002 L @7,76(0,@3) 0102 01960000 * IF COCO='06'X THEN 01970000 CLI 0(@7),X'06' 0103 01980000 BC 07,@9FA 0103 01990000 * R='1'B; /* READ INITIAL * 02000000 L @2,52(0,@3) 0104 02010000 OI 12(@2),B'10000000' 0104 02020000 * IF COCO='01'X THEN 02030000 @9FA CLI 0(@7),X'01' 0105 02040000 BC 07,@9F9 0105 02050000 * DO; /* WRITE COMMAND * 02060000 * W='1'B; 02070000 L @2,52(0,@3) 0107 02080000 OI 12(@2),B'01000000' 0107 02090000 * 02100000 * IF TCBRV='0'B /* IF IN VIRTUAL STORAGE Y02008* 02110000 * THEN /* MUST USE VIRT ADDRS Y02008* 02120000 L @4,CVTADPTR 0108 02130000 L @4,0(0,@4) CVTADDR 0108 02140000 MVC @TEMP4(4),328(@4) 0108 02150000 L @4,@TEMP4 CVT 0108 02160000 L @4,28(0,@4) CVTOLTEP 0108 02170000 MVC @TEMP4(4),8(@4) 0108 02180000 L @4,@TEMP4 OLTEPTAB 0108 02190000 TM 202(@4),B'10000000' 0108 02200000 BC 05,@9F8 0108 02210000 * DO; /* TO EXAMINE CCW'S Y02008* 02220000 * 02230000 * R15=CVTPTRV; /* ADDRESS V/R XLATR Y02008* 02240000 L @2,CVTADPTR 0110 02250000 L @2,0(0,@2) CVTADDR 0110 02260000 MVC @TEMP4(4),288(@2) 0110 02270000 L @F,@TEMP4 0110 02280000 * R1=DAD; /* ADDRESS CCW BUFR Y02008* 02290000 MVC @TEMP3+1(3),1(@7) 0111 02300000 L @1,@TEMP3 0111 02310000 * GEN( BALR R14,R15); /* XLATE VIRT TO REAL Y02008* 02320000 BALR R14,R15 02330000 DS 0H 02340000 * R8=R1; /* SAVE XLATED ADDR Y02008* 02350000 LR @8,@1 0113 02360000 * R1=R3; /* RESTORE IOSB PTR Y02008* 02370000 LR @1,@3 0114 02380000 BC 15,@9F7 0116 02390000 * 02400000 * END; /* END VIRT XLATE RTN Y02008* 02410000 * 02420000 * ELSE /* TASK IN REAL STOR Y02008* 02430000 * 02440000 * R8=DAD; /* DATA BUFFR IN CCW Y02008* 02450000 @9F8 MVC @TEMP3+1(3),1(@7) 0116 02460000 L @8,@TEMP3 0116 02470000 * 02480000 * IF DADBUF='76'X /* POS CHARACTER Y02008* 02490000 * & COMCHN='1'B THEN /* COMMAND CHAINING M4502* 02500000 @9F7 CLI 0(@8),X'76' 0117 02510000 BC 07,@9F6 0117 02520000 TM 4(@7),B'01000000' 0117 02530000 BC 12,@9F5 0117 02540000 * WR='1'B; 02550000 L @2,52(0,@3) 0118 02560000 OI 12(@2),B'00100000' 0118 02570000 * IF DADBUF='1F'X THEN ERRFLGS2='80'X;/*EOT? YES, R='1' Y02008* 02580000 @9F5 EQU * 0119 02590000 @9F6 CLI 0(@8),X'1F' 0119 02600000 BC 07,@9F4 0119 02610000 L @2,52(0,@3) 0120 02620000 MVI 12(@2),X'80' 0120 02630000 * END; 02640000 @9F4 EQU * 0121 02650000 * 02660000 * ERR003: 02670000 * R7=R10; /* RESTORE CCW PTR Y02008* 02680000 @9F9 EQU * 0122 02690000 ERR003 LR @7,@A 0122 02700000 * RELEASE (R8,R10); 02710000 * RESTRICT(R5); 02720000 * /* THIS SECTION IS USED TO TEST FOR INITIAL SELECTION * 02730000 * /* ERRORS. AN SIO CONDITION CODE OF '01' INDICATES * 02740000 * /* STATUS STORED. ANY STATUS AND SENSE INFORMATION OTHER * 02750000 * /* THAN UNIT CHECK (UCK) WITH SENSE INDICATING BUS OUT * 02760000 * /* CHECK (BOC) OR COMMAND REJECT (CRT) IS TREATED AS A * 02770000 * /* "SHOULD NOT OCCUR" (SNO) TYPE ERROR CONDITION * 02780000 * /* * 02790000 * IF IOSCC ='50'X THEN /* IS SIO CODE='01' Y02008* 02800000 CLI 20(@3),X'50' 0125 02810000 * GOTO LOADNEXT; /* YES. LOAD NEXT MODULE * 02820000 BC 08,LOADNEXT 0126 02830000 * /* * 02840000 * IF IOSCC='70'X THEN /* DEV CC=3 ON SIO? Y02008* 02850000 CLI 20(@3),X'70' 0127 02860000 BC 07,@9F3 0127 02870000 * 02880000 * DO; /* CC=3 ON SIO, MUST Y02008* 02890000 * CC3UCB=REIUCB; /* ADDRESS REI UCB Y02008* 02900000 L @2,CVTADPTR 0129 02910000 L @2,0(0,@2) CVTADDR 0129 02920000 MVC @TEMP4(4),328(@2) 0129 02930000 L @2,@TEMP4 CVT 0129 02940000 L @2,28(0,@2) CVTOLTEP 0129 02950000 MVC CC3PLIST+1(3),33(@2) 0129 02960000 * FUNCTCOD='00'X; /* VERIFY PATH FNCTN Y02008* 02970000 MVI CC3PLIST,X'00' 0130 02980000 * RESTRICT(R0,R13,R14,R15); /* REGS FOR US/IOS USEY02008* 02990000 * GEN( LOAD EP=IECVIOPM); /* LOAD PATH CHK MOD Y02008* 03000000 LOAD EP=IECVIOPM 03010000 DS 0H 03020000 * R14=R0; /* SAVE ENTRY ADDR Y02008* 03030000 LR @E,@0 0133 03040000 * R13=ADDR(IOSGENTBL); /* IOS SAVE/WORK AREA Y02008* 03050000 LA @D,40(0,@2) 0134 03060000 * R15=ADDR(ERR004); /* RET POINT IN CODE Y02008* 03070000 LA @F,ERR004 0135 03080000 * R1=ADDR(CC3PLIST); /* ADDRESS PARMLIST Y02008* 03090000 LA @1,CC3PLIST 0136 03100000 * GEN(BALR R14,R15); /* GO TO IECVIOPM Y02008* 03110000 BALR R14,R15 03120000 DS 0H 03130000 * 03140000 * ERR004: 03150000 * R1=R3; /* RESTORE IOSB ADDR Y02008* 03160000 ERR004 LR @1,@3 0138 03170000 * RELEASE (R0,R13,R14); /* FREE REGS FOR CMPLRY02008* 03180000 * IF R15^=0 /* IF NO PATHS AVAIL Y02008* 03190000 * THEN /* FOR I/O, THEN PERM Y02008* 03200000 LTR @F,@F 0140 03210000 * GO TO PERR; /* ERROR ON REI LINE Y02008* 03220000 BC 07,PERR 0141 03230000 * GO TO RETRY; /* RETRY EVENT Y02008* 03240000 BC 15,RETRY 0142 03250000 * END; /* END CC=3 CODE. Y02008* 03260000 * 03270000 * /* THIS SECTION CHECKS FOR CHANNEL DATA CHECK (CDC). IF * 03280000 * /* FOUND RETRYS THE CHANNEL PROGRAM THREE TIMES * 03290000 * /* * 03300000 * /* * 03310000 * IF CDC = '1'B THEN /*CHANNEL DATA CHECK ? * 03320000 @9F3 TM 25(@3),B'00001000' 0144 03330000 * GO TO ERRORA3X; /*IF POS THEN BRANCH * 03340000 BC 01,ERRORA3X 0145 03350000 * /* THIS SECTION TESTS FOR UNIT CHECK. IF UNIT CHECK (UCK) IS * 03360000 * /* INDICATED THEN CHECK FOR EQUIPMENT CHECK (ECK), LOST * 03370000 * /* DATA (LDA), TIME OUT (TOT), INTERVENTION REQUIRED (IRD), * 03380000 * /* BUS OUT CHECK (BOC), DATA CHECK (DCK), OVERRUN (OVR), * 03390000 * /* OR COMMAND REJECT (CRT). IF NONE ARE INDICATED THEN A * 03400000 * /* "SHOULD NOT OCCUR" (SNO) TYPE OF ERROR EXISTS * 03410000 * /* * 03420000 * IF UCK = '0'B THEN /*UNIT CHECK ? * 03430000 TM 24(@3),B'00000010' 0146 03440000 * GOTO LOADNEXT; /* LOAD NEXT MODULE * 03450000 BC 08,LOADNEXT 0147 03460000 * /* THIS SECTION TESTS FOR EQUIPMENT CHECK (ECK) IF UNIT * 03470000 * /* CHECK (UCK) HAS BEEN INDICATED. DEPENDING UPON THE * 03480000 * /* CURRENT CCW RECOVERY PROCEDURES ARE DEFINED * 03490000 * /* * 03500000 * IF ECK = '0'B THEN /*EQUIPMENT CHECK ? * 03510000 L @2,52(0,@3) 0148 03520000 TM 32(@2),B'00010000' 0148 03530000 * GO TO LOSTDATA; /*IF NEGATIVE BRANCH * 03540000 BC 08,LOSTDATA 0149 03550000 * /* TO LOSTDATA * 03560000 * IF COCO='27'X /* IF ENABLE COMMAND * 03570000 * | COCO='2F'X THEN /* OR DISABLE COMMAND * 03580000 CLI 0(@7),X'27' 0150 03590000 BC 08,@9F2 0150 03600000 CLI 0(@7),X'2F' 0150 03610000 BC 07,@9F1 0150 03620000 * GOTO ERRORA3X; /* RETRY 3 TIMES * 03630000 BC 08,ERRORA3X 0151 03640000 * /* * 03650000 * GO TO ERRORSNO; /*SHOULD NOT OCCUR * 03660000 BC 15,ERRORSNO 0152 03670000 * /* THIS SECTION TESTS FOR LOST DATA CHECK (LDA) IF UNIT * 03680000 * /* CHECK (UCK) HAS BEEN INDICATED. DEPENDING UPON THE * 03690000 * /* CURRENT CCW AND COMMAND CHAINING RECOVERY PROCEDURES * 03700000 * /* ARE DEFINED * 03710000 * /* * 03720000 * LOSTDATA: 03730000 * /* * 03740000 * IF LDA = '0'B THEN /*LOST DATA ? * 03750000 LOSTDATA L @2,52(0,@3) 0153 03760000 TM 32(@2),B'00000010' 0153 03770000 * GO TO TIMEOUT; /*IF NEGATIVE BRANCH * 03780000 BC 08,TIMEOUT 0154 03790000 * /* TO TIME OUT * 03800000 * IF COCO ^= '02'X THEN /* IF NOT A READ * 03810000 CLI 0(@7),X'02' 0155 03820000 * GOTO ERRORSNO; /* SHOULD NOT OCCUR * 03830000 BC 07,ERRORSNO 0156 03840000 * /* * 03850000 * NEXTEST0: 03860000 * /* * 03870000 * IF IOSCSWRC ^= '0000'X THEN /* RESIDUAL COUNT = 0 ? Y02008* 03880000 NEXTEST0 CLC 26(2,@3),@X18 0157 03890000 * GO TO NEXTEST1; /*IF NEGATIVE BRANCH * 03900000 BC 07,NEXTEST1 0158 03910000 * /* TO NEXT TEST * 03920000 * IF R='1'B THEN /* READ SEQUENCE * 03930000 L @2,52(0,@3) 0159 03940000 TM 12(@2),B'10000000' 0159 03950000 * GOTO ERRORSRR; 03960000 BC 01,ERRORSRR 0160 03970000 * 03980000 * IF W='1'B THEN /* WRITE SEQUENCE * 03990000 TM 12(@2),B'01000000' 0161 04000000 * GOTO ERRORIWC; 04010000 BC 01,ERRORIWC 0162 04020000 * 04030000 * GOTO ERRORSNO; 04040000 BC 15,ERRORSNO 0163 04050000 * /* * 04060000 * NEXTEST1: 04070000 * IF IOSCOD='48'THEN /*HALT I/O ISSUED ? Y02008* 04080000 NEXTEST1 CLC 13(1,@3),@C19 0164 04090000 * GO TO ERRORRFW; /*IF POSITIVE BRANCH * 04100000 BC 08,ERRORRFW 0165 04110000 * /* TO RECOVERY * 04120000 * GOTO ERRORSNO; 04130000 BC 15,ERRORSNO 0166 04140000 * /* THIS SECTION TESTS FOR TIME OUT (TOT) IF UNIT CHECK * 04150000 * /* (UCK) HAS BEEN INDICATED. DEPENDING UPON THE CURRENT * 04160000 * /* CCW AND COMMAND CHAINING RECOVERY PROCEDURES ARE DEFINED * 04170000 * /* * 04180000 * TIMEOUT: 04190000 * /* * 04200000 * IF TOT = '0'B THEN /*TIME OUT ? * 04210000 TIMEOUT L @2,52(0,@3) 0167 04220000 TM 32(@2),B'00000001' 0167 04230000 * GO TO INTEREQD; /*IF NEGATIVE BRANCH TO * 04240000 BC 08,INTEREQD 0168 04250000 * /* INTERVENTION REQ'D * 04260000 * IF COCO ^= '02'X THEN /* IF NOT A READ COMMAND * 04270000 CLI 0(@7),X'02' 0169 04280000 * DO; 04290000 * GOTO ERRORA3X; 04300000 BC 07,ERRORA3X 0171 04310000 * END; 04320000 * TEXTRANS: 04330000 * /* * 04340000 * IF COU = IOSCSWRC THEN /* CCW RESIDUAL CT=0 ? Y02008* 04350000 @9F0 EQU * 0173 04360000 TEXTRANS CLC 6(2,@7),26(@3) 0173 04370000 BC 07,@9EF 0173 04380000 * DO; 04390000 * IOSRST=IOSVST; /* RESTART CCWS AT 1ST CCW Y02008*/ 04400000 MVC 72(4,@3),76(@3) 0175 04410000 * GO TO ERRORA3X; /*IF POSITIVE BRANCH * 04420000 BC 15,ERRORA3X 0176 04430000 * /* TO RECOVERY * 04440000 * END; 04450000 * 04460000 * IF W='1'B THEN /* WRITE SEQUENCE * 04470000 @9EF L @2,52(0,@3) 0178 04480000 TM 12(@2),B'01000000' 0178 04490000 * GOTO ERRORSNO; /* SHOULD NOT ICCUR * 04500000 BC 01,ERRORSNO 0179 04510000 * 04520000 * GO TO ERRORIRR; /*BRANCH TO RECOVERY * 04530000 BC 15,ERRORIRR 0180 04540000 * /* THIS SECTION TESTS FOR INTERVENTION REQUIRED (IRD) IF * 04550000 * /* UNIT CHECK (UCK) HAS BEEN INDICATED. RECOVERY PROCEDURES * 04560000 * /* ARE DEFINED * 04570000 * /* * 04580000 * INTEREQD: 04590000 * IF IRD = '1'B THEN /*INTERVENTION REQUIRED ?* 04600000 INTEREQD L @2,52(0,@3) 0181 04610000 TM 32(@2),B'01000000' 0181 04620000 * GO TO ERRORECR; /*IF POSITIVE BRANCH * 04630000 BC 01,ERRORECR 0182 04640000 * /* TO RECOVERY * 04650000 * /* THIS SECTION TESTS FOR BUS OUT CHECK (BOC) IF UNIT CHECK * 04660000 * /* (UCK) HAS BEEN INDICATED. DEPENDING UPON THE NEXT CCW * 04670000 * /* TO BE EXECUTED THE RECOVERY PROCEDURES ARE DEFINED * 04680000 * /* * 04690000 * IF BOC = '0'B THEN /*BUS OUT CHECK ? * 04700000 TM 32(@2),B'00100000' 0183 04710000 * GOTO LOADNEXT; /* LOAD NEXT MODULE * 04720000 BC 08,LOADNEXT 0184 04730000 * SRCHRD: 04740000 * IF COMCHN='0'B THEN 04750000 SRCHRD TM 4(@7),B'01000000' 0185 04760000 * GOTO RETRY; 04770000 BC 08,RETRY 0186 04780000 * IF COCO='02'X THEN 04790000 CLI 0(@7),X'02' 0187 04800000 * GOTO RETRY; 04810000 BC 08,RETRY 0188 04820000 * R7=R7+8; 04830000 LA @7,8(0,@7) 0189 04840000 * IOSRST=R7; /* Y02008*/ 04850000 ST @7,72(0,@3) 0190 04860000 * GOTO SRCHRD; 04870000 BC 15,SRCHRD 0191 04880000 * 04890000 * LOADNEXT: 04900000 * 04910000 * /* THIS SECTION IS USED TO TEST FOR INITIAL SELECTION * 04920000 * /* ERRORS. AN SIO CONDITION CODE OF '01' INDICATES * 04930000 * /* STATUS STORED. ANY STATUS AND SENSE INFORMATION OTHER * 04940000 * /* THAN UNIT CHECK (UCK) WITH SENSE INDICATING BUS OUT * 04950000 * /* CHECK (BOC) OR COMMAND REJECT (CRT) IS TREATED AS A * 04960000 * /* "SHOULD NOT OCCUR" (SNO) TYPE ERROR CONDITION * 04970000 * /* * 04980000 * IF IOSCC^='50'X THEN /* DOES SIO CODE='01' Y02008* 04990000 LOADNEXT CLI 20(@3),X'50' 0192 05000000 * GOTO ERP2001; /* NO. BRANCH TO NEXT SECTION* 05010000 BC 07,ERP2001 0193 05020000 * /* * 05030000 * IF UCK = '0'B THEN /*UNIT CHECK ? * 05040000 TM 24(@3),B'00000010' 0194 05050000 * GO TO ERRORSNO; /*IF NEG THEN BRANCH * 05060000 BC 08,ERRORSNO 0195 05070000 * /* * 05080000 * IF BOC = '1'B THEN /*BUS OUT CHECK ? * 05090000 L @2,52(0,@3) 0196 05100000 TM 32(@2),B'00100000' 0196 05110000 * GO TO ERRORA2X; /*IF POS THEN BRANCH * 05120000 BC 01,ERRORA2X 0197 05130000 * /* * 05140000 * IF CRT = '1'B THEN /*COMMAND REJECT ? * 05150000 TM 32(@2),B'10000000' 0198 05160000 * GO TO ERRORA3X; /*IF POS THEN BRANCH * 05170000 BC 01,ERRORA3X 0199 05180000 * /* * 05190000 * GO TO ERRORSNO; /*SHOULD NOT OCCUR * 05200000 BC 15,ERRORSNO 0200 05210000 * ERP2001: 05220000 * IF UCK='0'B THEN 05230000 ERP2001 TM 24(@3),B'00000010' 0201 05240000 * GOTO SECTION4; 05250000 BC 08,SECTION4 0202 05260000 * 05270000 * /* THIS SECTION TESTS FOR DATA CHECK (DCK) IF UNIT CHECK * 05280000 * /* (UCK) HAS BEEN INDICATED. DEPENDING UPON THE PRESENT * 05290000 * /* CCW BEING EXECUTED AND THE CHAINED COMMAND IF ANY * 05300000 * /* * 05310000 * DATCHECK: 05320000 * /* * 05330000 * IF DCK = '0'B THEN /*DATA CHECK ? * 05340000 DATCHECK L @2,52(0,@3) 0203 05350000 TM 32(@2),B'00001000' 0203 05360000 * GO TO OVERRUN; /*IF NEGATIVE BRANCH * 05370000 BC 08,OVERRUN 0204 05380000 * /* TO OVER RUN * 05390000 * IF COCO = '02'X THEN GOTO TESTNEX2; /* READ COMMAND * 05400000 CLI 0(@7),X'02' 0205 05410000 BC 08,TESTNEX2 0206 05420000 * IF COCO='01'X THEN 05430000 CLI 0(@7),X'01' 0207 05440000 BC 07,@9EE 0207 05450000 * DO; 05460000 * 05470000 * IF WR='1'B THEN /* WRITE EOT,READ RESP * 05480000 TM 12(@2),B'00100000' 0209 05490000 * GOTO ERRORIWC; 05500000 BC 01,ERRORIWC 0210 05510000 * 05520000 * GOTO ERRORRFW; 05530000 BC 15,ERRORRFW 0211 05540000 * END; 05550000 * 05560000 * GO TO ERRORSNO; /*BRANCH TO RECOVERY * 05570000 * /* * 05580000 * /* * 05590000 * TESTNEX2: 05600000 * /* * 05610000 * IF R='1'B THEN /* READ SEQUENCE * 05620000 TESTNEX2 L @2,52(0,@3) 0214 05630000 TM 12(@2),B'10000000' 0214 05640000 * GOTO ERRORIRR; 05650000 BC 01,ERRORIRR 0215 05660000 * 05670000 * IF WR='1'B THEN /* WRITE EOT,READ RESP * 05680000 TM 12(@2),B'00100000' 0216 05690000 * GOTO ERRORIWC; 05700000 BC 01,ERRORIWC 0217 05710000 * 05720000 * GOTO ERRORRFW; 05730000 BC 15,ERRORRFW 0218 05740000 * /* THIS SECTION TESTS FOR OVER RUN (OVR) IF UNIT CHECK * 05750000 * /* (UCK) HAS BEEN INDICATED. DEPENDING UPON CURRENT CCW * 05760000 * /* RECOVERY PROCEDURES ARE DEFINED * 05770000 * /* * 05780000 * OVERRUN: 05790000 * /* * 05800000 * IF OVR = '0'B THEN /* OVER RUN ? * 05810000 OVERRUN L @2,52(0,@3) 0219 05820000 TM 32(@2),B'00000100' 0219 05830000 * GO TO COMANREJ; /*IF NEGATIVE BRANCH * 05840000 BC 08,COMANREJ 0220 05850000 * /* TO COMMAND REJECT * 05860000 * IF COCO ='CA'X /* INHIBIT COMMAND * 05870000 * | COCO='02'X THEN /* READ COMMAND * 05880000 CLI 0(@7),X'CA' 0221 05890000 BC 08,@9ED 0221 05900000 CLI 0(@7),X'02' 0221 05910000 BC 07,@9EC 0221 05920000 * GOTO ERRORIRR; 05930000 BC 08,ERRORIRR 0222 05940000 * /* * 05950000 * GO TO ERRORSNO; /*SHOULD NOT OCCUR * 05960000 BC 15,ERRORSNO 0223 05970000 * /* THIS SECTION TESTS FOR COMMAND REJECT (CRT) IF UNIT * 05980000 * /* CHECK (UCK) HAS BEEN INDICATED. ERROR RECOVERY * 05990000 * /* PROCEDURES ARE DEFINED * 06000000 * /* * 06010000 * COMANREJ: 06020000 * /* * 06030000 * IF CRT = '1'B THEN /*COMMAND REJECT * 06040000 COMANREJ L @2,52(0,@3) 0224 06050000 TM 32(@2),B'10000000' 0224 06060000 * GOTO ERRORA2X; 06070000 BC 01,ERRORA2X 0225 06080000 * /* THIS SECTION TEST FOR THE CHANNEL STATUS ERRORS PROGRAM * 06090000 * /* CHECK, PROTECTION CHECK, OR CHAINING CHECK. ERROR * 06100000 * /* RECOVERY PROCEDURES ARE DEFINED * 06110000 * /* * 06120000 * SECTION4: 06130000 * IF PCK = '1'B /*PROGRAM CHECK ? * 06140000 * | PRK = '1'B /*PROTECTION CHECK ? * 06150000 * | CHC = '1'B THEN /*CHAINING CHECK ? * 06160000 SECTION4 TM 25(@3),B'00100000' 0226 06170000 BC 01,@9EB 0226 06180000 TM 25(@3),B'00010000' 0226 06190000 BC 01,@9EA 0226 06200000 TM 25(@3),B'00000001' 0226 06210000 BC 12,@9E9 0226 06220000 * GO TO ERRORA3X; /*IF POSITIVE BRANCH * 06230000 BC 03,ERRORA3X 0227 06240000 * /* TO RECOVERY * 06250000 * /* THIS SECTION TESTS FOR THE CHANNEL STATUS ERROR UNIT * 06260000 * /* EXCEPTION (UEX). DEPENDING UPON THE PRESENT CCW AND * 06270000 * /* PRESENT COMMAND CHAIN, IF ANY, RECOVERY PROCEDURES ARE * 06280000 * /* DEFINED * 06290000 * /* * 06300000 * IF UEX = '0'B THEN /*UNIT EXCEPTION ? * 06310000 @9E9 TM 24(@3),B'00000001' 0228 06320000 * GOTO CKPREP; /* CHECK IF PREPARE COMMAND * 06330000 BC 08,CKPREP 0229 06340000 * 06350000 * IF COCO='02'X THEN /* READ COMMAND * 06360000 CLI 0(@7),X'02' 0230 06370000 * GOTO CHECKER0; 06380000 BC 08,CHECKER0 0231 06390000 * 06400000 * IF COCO='01'X THEN /* WRITE COMMAND * 06410000 CLI 0(@7),X'01' 0232 06420000 * GOTO ERRORRFW; 06430000 BC 08,ERRORRFW 0233 06440000 * /* * 06450000 * GO TO NOERITOK; /*NO ERROR CONDITION - * 06460000 BC 15,NOERITOK 0234 06470000 * /* RETURN * 06480000 * CHECKER0: 06490000 * /* * 06500000 * IF R='1'B THEN /* READ SEQUENCE * 06510000 CHECKER0 L @2,52(0,@3) 0235 06520000 TM 12(@2),B'10000000' 0235 06530000 * GOTO ERRORIWC; /*Y02008* 06540000 BC 01,ERRORIWC 0236 06550000 * 06560000 * IF W='1'B THEN /* WRITE SEQUENCE * 06570000 TM 12(@2),B'01000000' 0237 06580000 BC 12,@9E8 0237 06590000 * DO; 06600000 * IF WR='1'B THEN /* WRITE EOT, READ RESP M4502* 06610000 TM 12(@2),B'00100000' 0239 06620000 * GOTO NOERITOK; /* NO ERROR CONDITION M4502* 06630000 BC 01,NOERITOK 0240 06640000 * 06650000 * IOSRST=IOSVST; /* RESTART = START ADDR Y02008 06660000 MVC 72(4,@3),76(@3) 0241 06670000 * GOTO RETRY1; 06680000 BC 15,RETRY1 0242 06690000 * 06700000 * END; 06710000 * 06720000 * GO TO NOERITOK; /*NO ERROR CONDITION - * 06730000 * /* RETURN * 06740000 * CKPREP: 06750000 * IF COCO='06'X THEN /* PREPARE COMMAND * 06760000 CKPREP CLI 0(@7),X'06' 0245 06770000 * GOTO ERRORRFW; 06780000 BC 08,ERRORRFW 0246 06790000 * /* THIS SECTION TESTS FOR INCORRECT LENGTH (ILH) BUT * 06800000 * /* THIS CONDITION IS NOT TREATED AS AN ERROR CONDITION * 06810000 * INCORLGH: 06820000 * IF ILH = '1'B THEN /*INCORRECT LENGTH ? * 06830000 INCORLGH TM 25(@3),B'01000000' 0247 06840000 * GO TO NOERITOK; /*NO ERROR CONDITION - * 06850000 BC 01,NOERITOK 0248 06860000 * /* RETURN * 06870000 * /* THIS SECTION TESTS FOR BUSY (BUS), ATTENTION (ATT), * 06880000 * /* CONTROL UNIT END (CUE), STATUS MODIFIER (STM) AND * 06890000 * /* BRANCHES TO RECOVERY FOR THREE RETRYS * 06900000 * /* * 06910000 * IF BUS = '1'B THEN /*BUSY ? * 06920000 TM 24(@3),B'00010000' 0249 06930000 * GO TO ERRORA3X; /*IF POSITIVE BRANCH * 06940000 BC 01,ERRORA3X 0250 06950000 * /* TO RECOVERY * 06960000 * IF ATT = '1'B THEN /*ATTENTION ? * 06970000 TM 24(@3),B'10000000' 0251 06980000 * GO TO ERRORA3X; /*IF POSITIVE BRANCH * 06990000 BC 01,ERRORA3X 0252 07000000 * /* TO RECOVERY * 07010000 * IF CUE = '1'B THEN /*CONTROL UNIT END ? * 07020000 TM 24(@3),B'00100000' 0253 07030000 * GO TO ERRORA3X; /*IF POSITIVE BRANCH * 07040000 BC 01,ERRORA3X 0254 07050000 * /* TO RECOVERY * 07060000 * IF STM = '1'B THEN /*STATUS MODIFIER ? * 07070000 TM 24(@3),B'01000000' 0255 07080000 * GO TO ERRORA3X; /*IF POSITIVE BRANCH * 07090000 BC 01,ERRORA3X 0256 07100000 * /* TO RECOVERY * 07110000 * 07120000 * 07130000 * GOTO NOERITOK; /* M4502* 07140000 BC 15,NOERITOK 0257 07150000 * 07160000 * RESTRICT (R4); 07170000 * 07180000 * ERRORA2X: 07190000 * 07200000 * IF FECT ='03'X THEN /* IS THIS A PERMANENT ERROR * 07210000 ERRORA2X L @2,52(0,@3) 0259 07220000 CLI 10(@2),X'03' 0259 07230000 * GOTO PERR; 07240000 BC 08,PERR 0260 07250000 * 07260000 * ELSE GOTO RETRY; /* RETRY CHAN PROGRAM * 07270000 BC 15,RETRY 0261 07280000 * 07290000 * 07300000 * ERRORA3X: 07310000 * 07320000 * IF FECT ='04'X THEN /* IS THIS A PERM ERROR ? * 07330000 ERRORA3X L @2,52(0,@3) 0262 07340000 CLI 10(@2),X'04' 0262 07350000 * GOTO PERR; /* GO SET UP FOR RETURN * 07360000 BC 08,PERR 0263 07370000 * 07380000 * ELSE 07390000 * GOTO RETRY; /* RETRY CHAN PROGRAM * 07400000 BC 15,RETRY 0264 07410000 * 07420000 * 07430000 * ERRORRFW: 07440000 * 07450000 * CCWA(1:8)=CCWRDSKP(1:8); /* MOVE IN READ SKIP CCW * 07460000 ERRORRFW MVC 0(8,@9),CCWRDSKP 0265 07470000 * CCWADAT=DAT1; 07480000 L @2,52(0,@3) 0266 07490000 MVC 1(3,@9),89(@2) 0266 07500000 * CCWB(1:8)=CCWWREOT(1:8); /* MOVE IN WRITE EOT * 07510000 MVC 8(8,@9),CCWWREOT 0267 07520000 * CCWBDAT=EOT; 07530000 MVC 9(3,@9),81(@2) 0268 07540000 * CCWC(1:8)=CCWRDEOT(1:8); /* MOVE IN READ EOT * 07550000 MVC 16(8,@9),CCWRDEOT 0269 07560000 * CCWCDAT=DAT1; 07570000 MVC 17(3,@9),89(@2) 0270 07580000 * DISP=25; /* POINT TO NEXT AVAILABLE SP * 07590000 LA @4,25 0271 07600000 * GOTO MOVECHN; /* MOVE IN CHAIN & RETRY * 07610000 BC 15,MOVECHN 0272 07620000 * 07630000 * 07640000 * ERRORSRR: 07650000 * CCWA(1:8)=CCWRDSKP(1:8); /* MOVE IN READ SKIP * 07660000 ERRORSRR MVC 0(8,@9),CCWRDSKP 0273 07670000 * CCWADAT=DAT1; 07680000 L @2,52(0,@3) 0274 07690000 MVC 1(3,@9),89(@2) 0274 07700000 * CCWB(1:8)=CCWWRNEG(1:8); /* MOVE IN WRITE NEGATIVE * 07710000 MVC 8(8,@9),CCWWRNEG 0275 07720000 * CCWBDAT=NEG; 07730000 MVC 9(3,@9),85(@2) 0276 07740000 * R5=IOSVST; /* USER CHANNEL PROGRAM Y0200* 07750000 L @5,76(0,@3) 0277 07760000 * 07770000 * SRR1:IF OP1 = '02'X THEN DO; /* SEARCH CHAIN FOR A READ CCW* 07780000 SRR1 CLI 0(@5),X'02' 0278 07790000 BC 07,@9E7 0278 07800000 * CCWC(1:8)=CCWCHAIN(1:8); /* THEN MOVE IT IN * 07810000 MVC 16(8,@9),0(@5) 0280 07820000 * IOSRST=R9; /* RESTART CHAN PROG Y02008* 07830000 ST @9,72(0,@3) 0281 07840000 * GOTO RETRY; /* RETRY * 07850000 BC 15,RETRY 0282 07860000 * END; 07870000 * 07880000 * R5=R5+8; 07890000 @9E7 AH @5,@D3 0284 07900000 * 07910000 * GOTO SRR1; /* LOOP * 07920000 BC 15,SRR1 0285 07930000 * 07940000 * 07950000 * ERRORIWC: 07960000 * IOSRST=IOSVST; /* RETRY ADDR=START ADDR Y02008* 07970000 ERRORIWC MVC 72(4,@3),76(@3) 0286 07980000 * GOTO RETRY; /* RETRY IT * 07990000 BC 15,RETRY 0287 08000000 * 08010000 * 08020000 * ERRORIRR: 08030000 * CCWA(1:8)=CCWWRNEG(1:8); /* MOVE WRITE NEGATIVE IN WORK* 08040000 ERRORIRR MVC 0(8,@9),CCWWRNEG 0288 08050000 * CCWADAT=NEG; 08060000 L @2,52(0,@3) 0289 08070000 MVC 1(3,@9),85(@2) 0289 08080000 * R5=IOSVST; /* POINT TO USERS CCW CHAIN Y02008 08090000 L @5,76(0,@3) 0290 08100000 * 08110000 * IRR1:IF OP1 = '02'X THEN DO; /* SEARCH FOR A READ CCW * 08120000 IRR1 CLI 0(@5),X'02' 0291 08130000 BC 07,@9E6 0291 08140000 * CCWB(1:8)=CCWCHAIN(1:8); /* WHEN FOUND MOVE IN WORK AR * 08150000 MVC 8(8,@9),0(@5) 0293 08160000 * IOSRST=R9; /*Y02008* 08170000 ST @9,72(0,@3) 0294 08180000 * GOTO RETRY; /* RETRY IT * 08190000 BC 15,RETRY 0295 08200000 * END; 08210000 * 08220000 * ELSE; 08230000 @9E6 EQU * 0297 08240000 * R5=R5+8; 08250000 @9E5 AH @5,@D3 0298 08260000 * GOTO IRR1; /* LOOP * 08270000 BC 15,IRR1 0299 08280000 * 08290000 * 08300000 * ERRORECR: 08310000 * CCWA(1:8)=CCWENABL(1:8); /* MOVE ENABLE CCW IN WORKAREA* 08320000 ERRORECR MVC 0(8,@9),CCWENABL 0300 08330000 * DISP=9; /* POINT TO NEXT SPACE IN WORK* 08340000 LA @4,9 0301 08350000 * GOTO MOVECHN; /* GO MOVE IN USERS CCW CHAIN * 08360000 BC 15,MOVECHN 0302 08370000 * 08380000 * 08390000 * ERRORSNO: 08400000 * IF FECT ='04'X THEN /* IS THIS A PERM ERROR ? * 08410000 ERRORSNO L @2,52(0,@3) 0303 08420000 CLI 10(@2),X'04' 0303 08430000 * GOTO PERR; /* GO SET UP FOR ERR RETURN * 08440000 BC 08,PERR 0304 08450000 * ELSE GOTO RETRY; /* SET UP FOR CHAN PROG RETRY* 08460000 BC 15,RETRY 0305 08470000 * 08480000 * NOERITOK: 08490000 * 08500000 * R2=IOSRST; 08510000 NOERITOK L @2,72(0,@3) 0306 08520000 * GEN; 08530000 LRA 2,0(0,2) 08540000 BNZ PERR 08550000 DS 0H 08560000 * IOSRST=R2; 08570000 ST @2,72(0,@3) 0308 08580000 * 08590000 * SENSE='0000'X; /* ZERO SENSE IN ERPWK Y02008* 08600000 L @2,52(0,@3) 0309 08610000 MVC 32(2,@2),@X18 0309 08620000 * ERRFLGS2='00'X; /* SERO FLAGS IN ERPWK Y02008* 08630000 MVI 12(@2),X'00' 0310 08640000 * SRS='0'B; 08650000 NI 11(@2),B'00111111' 0311 08660000 * IOBENT='0'B; 08670000 * FECT='00'X; 08680000 MVI 10(@2),X'00' 0313 08690000 * IOSERR ='0'B; /* SET IOBERR TO ZERO Y02008*/ 08700000 NI 0(@3),B'11011011' 0314 08710000 * IOSEX='0'B; /* SET IOBEX BIT TO ZERO Y02008*/ 08720000 * IOSTATUS='0C00'X; /* SET CSWFLAGS TO NORMAL Y02008*/ 08730000 MVC 24(2,@3),@X23 0316 08740000 * GEN(SVC 15); 08750000 SVC 15 08760000 DS 0H 08770000 * GEN(SVC 3); /* RETURN TO IOS * 08780000 SVC 3 08790000 DS 0H 08800000 * 08810000 * /*THIS PROCEDURE MOVES CCWS FROM USERS "HAIN TO ERP WORK AREA * 08820000 * 08830000 * MOVECHN: 08840000 * R5=IOSVST; /* USERS CCW START ADDR Y02008* 08850000 MOVECHN L @5,76(0,@3) 0319 08860000 * NEXT:CCWWORK(DISP:DISP+7)=CCWCHAIN(1:8); /* MOVE IN CCW * 08870000 NEXT LR @2,@4 0320 08880000 LA @A,0(@2,@9) 0320 08890000 BCTR @A,0 0320 08900000 MVC 0(8,@A),0(@5) 0320 08910000 * 08920000 * IF CHN1 = '1'B THEN DO; /* IS IT CHAINED? IF YES* 08930000 TM 4(@5),B'01000000' 0321 08940000 BC 12,@9E4 0321 08950000 * R5=R5+8; /* SET UP TO MOVE IN * 08960000 AH @5,@D3 0323 08970000 * DISP=DISP+8; /* NEXT CCW * 08980000 AH @4,@D3 0324 08990000 * GOTO NEXT; /* GO DO IT * 09000000 BC 15,NEXT 0325 09010000 * END; 09020000 * 09030000 * IOSRST=R9; /* IOSRST ADDR = NEW CCWS Y02008* 09040000 @9E4 ST @9,72(0,@3) 0327 09050000 * 09060000 * 09070000 * RETRY: 09080000 * IF FECT='04'X THEN 09090000 RETRY L @2,52(0,@3) 0328 09100000 CLI 10(@2),X'04' 0328 09110000 * GOTO PERR; 09120000 BC 08,PERR 0329 09130000 * 09140000 * FECT=FECT+1; /* UPDATE IOB ERROR COUNT * 09150000 LA @F,1 0330 09160000 SR @0,@0 0330 09170000 IC @0,10(0,@2) 0330 09180000 AR @F,@0 0330 09190000 STC @F,10(0,@2) 0330 09200000 * 09210000 * RETRY1: 09220000 * RESTRICT(R2); 09230000 * 09240000 * R2=IOSRST; /* PUT REAL ADD IN REG Y02008* 09250000 RETRY1 L @2,72(0,@3) 0332 09260000 * 09270000 * GEN; 09280000 LRA 2,0(0,2) GET REAL ADR OF VIRT CP Y02008 09290000 BNZ PERR PERM ERR IF XLATE FAIL Y02008 09300000 DS 0H 09310000 * 09320000 * IOSRST=R2; /* PUT REAL AD IN IOSB Y02008* 09330000 ST @2,72(0,@3) 0334 09340000 * 09350000 * 09360000 * ERRFLGS2='00'X; /* ZERO INTERNAL FLAGS Y02008* 09370000 L @8,52(0,@3) 0335 09380000 MVI 12(@8),X'00' 0335 09390000 * GEN(SVC 15); 09400000 SVC 15 09410000 DS 0H 09420000 * GEN(SVC 3); /* RETURN TO IOS * 09430000 SVC 3 09440000 DS 0H 09450000 * 09460000 * 09470000 * PERR: 09480000 * 09490000 * R2=IOSRST; 09500000 PERR L @2,72(0,@3) 0338 09510000 * GEN; 09520000 LRA 2,0(0,2) 09530000 BNZ PERR 09540000 DS 0H 09550000 * IOSRST=R2; 09560000 ST @2,72(0,@3) 0340 09570000 * 09580000 * 09590000 * IOSERR='0'B; /* ZERO IOBERR BIT Y02008* 09600000 NI 0(@3),B'11011111' 0341 09610000 * ERRFLGS2='00'X; /* ZERO INTERNAL FLAGS Y02008* 09620000 L @8,52(0,@3) 0342 09630000 MVI 12(@8),X'00' 0342 09640000 * GEN(SVC 15); 09650000 SVC 15 09660000 DS 0H 09670000 * GEN(SVC 3); /* RETURN TO IOS * 09680000 SVC 3 09690000 DS 0H 09700000 * 09710000 * RETURN; 09720000 * END; 09730000 @EL01 BCR 15,@E 0346 09740000 @DATA1 EQU * 09750000 @0 EQU 00 EQUATES FOR REGISTERS 0-15 09760000 @1 EQU 01 09770000 @2 EQU 02 09780000 @3 EQU 03 09790000 @4 EQU 04 09800000 @5 EQU 05 09810000 @6 EQU 06 09820000 @7 EQU 07 09830000 @8 EQU 08 09840000 @9 EQU 09 09850000 @A EQU 10 09860000 @B EQU 11 09870000 @C EQU 12 09880000 @D EQU 13 09890000 @E EQU 14 09900000 @F EQU 15 09910000 @D1 DC F'0' 09920000 @D2 DC H'-8' 09930000 @D3 DC H'8' 09940000 DS 0F 09950000 @SIZ001 DC AL1(&SPN) 09960000 DC AL3(@DATEND-@DATD) 09970000 DS 0F 09980000 @X18 DC X'0000' 09990000 @C19 DC C'48' 10000000 @X23 DC X'0C00' 10010000 DS 0D 10020000 @DATA EQU * 10030000 P EQU 00000000 FULLWORD INTEGER 10040000 R0 EQU 00000000 FULLWORD POINTER REGISTER 10050000 R1 EQU 00000001 FULLWORD POINTER REGISTER 10060000 R2 EQU 00000002 FULLWORD POINTER REGISTER 10070000 R3 EQU 00000003 FULLWORD POINTER REGISTER 10080000 R4 EQU 00000004 FULLWORD INTEGER REGISTER 10090000 R5 EQU 00000005 FULLWORD POINTER REGISTER 10100000 R6 EQU 00000006 FULLWORD POINTER REGISTER 10110000 R7 EQU 00000007 3 BYTE POINTER REGISTER 10120000 R8 EQU 00000008 FULLWORD POINTER REGISTER 10130000 R9 EQU 00000009 3 BYTE POINTER REGISTER 10140000 R10 EQU 00000010 FULLWORD INTEGER REGISTER 10150000 R11 EQU 00000011 FULLWORD INTEGER REGISTER 10160000 R12 EQU 00000012 FULLWORD INTEGER REGISTER 10170000 R13 EQU 00000013 FULLWORD INTEGER REGISTER 10180000 R14 EQU 00000014 FULLWORD INTEGER REGISTER 10190000 R15 EQU 00000015 FULLWORD INTEGER REGISTER 10200000 DISP EQU 00000004 FULLWORD INTEGER REGISTER 10210000 IOSBPTR EQU 00000003 FULLWORD POINTER REGISTER 10220000 IOSBCB EQU 00000000 91 BYTE(S) ON WORD 10230000 IOSFLA EQU IOSBCB+00000000 1 BYTE(S) 10240000 A00000 EQU IOSBCB+00000000 2 BIT(S) 10250000 IOSERR EQU IOSBCB+00000000 1 BIT(S) 10260000 A00001 EQU IOSBCB+00000000 2 BIT(S) 10270000 IOSEX EQU IOSBCB+00000000 1 BIT(S) 10280000 A00002 EQU IOSBCB+00000001 12 BYTE(S) 10290000 IOSCOD EQU IOSBCB+00000013 1 BYTE(S) 10300000 A00003 EQU IOSBCB+00000014 6 BYTE(S) 10310000 IOSCC EQU IOSBCB+00000020 1 BYTE(S) 10320000 IOSCSWCA EQU IOSBCB+00000021 3 BYTE(S) 10330000 IOSTATUS EQU IOSBCB+00000024 2 BYTE(S) 10340000 IOSTSA EQU IOSBCB+00000024 1 BYTE(S) 10350000 ATT EQU IOSBCB+00000024 1 BIT(S) 10360000 STM EQU IOSBCB+00000024 1 BIT(S) 10370000 CUE EQU IOSBCB+00000024 1 BIT(S) 10380000 BUS EQU IOSBCB+00000024 1 BIT(S) 10390000 CED EQU IOSBCB+00000024 1 BIT(S) 10400000 DED EQU IOSBCB+00000024 1 BIT(S) 10410000 UCK EQU IOSBCB+00000024 1 BIT(S) 10420000 UEX EQU IOSBCB+00000024 1 BIT(S) 10430000 IOSTSB EQU IOSBCB+00000025 1 BYTE(S) 10440000 PCI EQU IOSBCB+00000025 1 BIT(S) 10450000 ILH EQU IOSBCB+00000025 1 BIT(S) 10460000 PCK EQU IOSBCB+00000025 1 BIT(S) 10470000 PRK EQU IOSBCB+00000025 1 BIT(S) 10480000 CDC EQU IOSBCB+00000025 1 BIT(S) 10490000 CCC EQU IOSBCB+00000025 1 BIT(S) 10500000 ICC EQU IOSBCB+00000025 1 BIT(S) 10510000 CHC EQU IOSBCB+00000025 1 BIT(S) 10520000 IOSCSWRC EQU IOSBCB+00000026 2 BYTE(S) 10530000 A00004 EQU IOSBCB+00000028 24 BYTE(S) 10540000 IOSERP EQU IOSBCB+00000052 FULLWORD POINTER 10550000 A00005 EQU IOSBCB+00000056 16 BYTE(S) 10560000 IOSRST EQU IOSBCB+00000072 FULLWORD POINTER 10570000 IOSVST EQU IOSBCB+00000076 FULLWORD POINTER 10580000 A00006 EQU IOSBCB+00000080 10 BYTE(S) 10590000 IOSMDB EQU IOSBCB+00000090 1 BYTE(S) 10600000 ERRFLGS1 EQU 00000011 1 BYTE(S) 10610000 IOBENT EQU ERRFLGS1+00000000 1 BIT(S) 10620000 SRS EQU ERRFLGS1+00000000 1 BIT(S) 10630000 ERRFLGS2 EQU 00000012 1 BYTE(S) 10640000 R EQU ERRFLGS2+00000000 1 BIT(S) 10650000 W EQU ERRFLGS2+00000000 1 BIT(S) 10660000 WR EQU ERRFLGS2+00000000 1 BIT(S) 10670000 SENSE EQU 00000032 2 BYTE(S) 10680000 CRT EQU SENSE+00000000 1 BIT(S) 10690000 IRD EQU SENSE+00000000 1 BIT(S) 10700000 BOC EQU SENSE+00000000 1 BIT(S) 10710000 ECK EQU SENSE+00000000 1 BIT(S) 10720000 DCK EQU SENSE+00000000 1 BIT(S) 10730000 OVR EQU SENSE+00000000 1 BIT(S) 10740000 LDA EQU SENSE+00000000 1 BIT(S) 10750000 TOT EQU SENSE+00000000 1 BIT(S) 10760000 A00007 EQU SENSE+00000001 8 BIT(S) 10770000 FECT EQU 00000010 1 BYTE(S) 10780000 LINEDATA EQU 00000080 15 BYTE(S) 10790000 EOT EQU LINEDATA+00000000 4 BYTE POINTER 10800000 NEG EQU LINEDATA+00000004 4 BYTE POINTER 10810000 DAT1 EQU LINEDATA+00000008 4 BYTE POINTER 10820000 EOTDATA EQU LINEDATA+00000012 1 BYTE(S) 10830000 NEGDATA EQU LINEDATA+00000013 1 BYTE(S) 10840000 DAT1DATA EQU LINEDATA+00000014 1 BYTE(S) 10850000 CVTADPTR EQU * FULLWORD POINTER 10860000 DC AL4(16) 10870000 CVTADDR EQU 00000000 FULLWORD POINTER 10880000 CVT EQU 00000000 1 BYTE(S) 10890000 A00008 EQU CVT+00000000 288 BYTE(S) 10900000 CVTPTRV EQU CVT+00000288 4 BYTE POINTER 10910000 A00009 EQU CVT+00000292 36 BYTE(S) 10920000 CVTEXT2 EQU CVT+00000328 4 BYTE POINTER 10930000 CVTOLTEP EQU 00000028 FULLWORD POINTER 10940000 OLTEPTAB EQU 00000000 24 BYTE(S) 10950000 DIEHEAD EQU OLTEPTAB+00000000 4 BYTE(S) 10960000 REIDEBAD EQU OLTEPTAB+00000004 4 BYTE POINTER 10970000 OLTEPTCB EQU OLTEPTAB+00000008 4 BYTE POINTER 10980000 A00010 EQU OLTEPTAB+00000012 20 BYTE(S) 10990000 REIUCB EQU OLTEPTAB+00000032 4 BYTE POINTER 11000000 A00011 EQU OLTEPTAB+00000036 4 BYTE(S) 11010000 IOSGENTB EQU OLTEPTAB+00000040 18*4 BYTE INTEGER 11020000 OURTCB EQU 00000000 206 BYTE(S) 11030000 A00012 EQU OURTCB+00000000 202 BYTE(S) 11040000 TCBFLGS6 EQU OURTCB+00000202 1 BYTE(S) 11050000 TCBRV EQU OURTCB+00000202 1 BIT(S) 11060000 A00013 EQU OURTCB+00000202 7 BIT(S) 11070000 CCW EQU 00000000 64 BIT(S) ON BYTE 11080000 COCO EQU CCW+00000000 8 BIT(S) 11090000 DAD EQU CCW+00000001 24 BIT(S) 11100000 FLAG12 EQU CCW+00000004 8 BIT(S) 11110000 A00014 EQU CCW+00000004 1 BIT(S) 11120000 COMCHN EQU CCW+00000004 1 BIT(S) 11130000 A00015 EQU CCW+00000004 1 BIT(S) 11140000 SKIP EQU CCW+00000004 1 BIT(S) 11150000 FLOBS EQU CCW+00000004 4 BIT(S) 11160000 BLA EQU CCW+00000005 8 BIT(S) 11170000 COU EQU CCW+00000006 16 BIT(S) 11180000 CCWCHAIN EQU 00000000 8 BYTE(S) 11190000 CCW1 EQU CCWCHAIN+00000000 8 BYTE(S) 11200000 OP1 EQU CCWCHAIN+00000000 1 BYTE(S) 11210000 BUFADR1 EQU CCWCHAIN+00000001 3 BYTE POINTER 11220000 FLAGS0 EQU CCWCHAIN+00000004 8 BIT(S) 11230000 A00016 EQU CCWCHAIN+00000004 1 BIT(S) 11240000 CHN1 EQU CCWCHAIN+00000004 1 BIT(S) 11250000 A00017 EQU CCWCHAIN+00000004 6 BIT(S) 11260000 A00018 EQU CCWCHAIN+00000005 1 BYTE(S) 11270000 CNT1 EQU CCWCHAIN+00000006 2 BYTE(S) 11280000 CCWWORK EQU 00000000 40 BYTE(S) ON DWORD 11290000 CCWA EQU CCWWORK+00000000 8 BYTE(S) 11300000 A00019 EQU CCWWORK+00000000 1 BYTE(S) 11310000 CCWADAT EQU CCWWORK+00000001 3 BYTE POINTER 11320000 A00020 EQU CCWWORK+00000004 4 BYTE(S) 11330000 CCWB EQU CCWWORK+00000008 8 BYTE(S) 11340000 A00021 EQU CCWWORK+00000008 1 BYTE(S) 11350000 CCWBDAT EQU CCWWORK+00000009 3 BYTE POINTER 11360000 A00022 EQU CCWWORK+00000012 4 BYTE(S) 11370000 CCWC EQU CCWWORK+00000016 8 BYTE(S) 11380000 A00023 EQU CCWWORK+00000016 1 BYTE(S) 11390000 CCWCDAT EQU CCWWORK+00000017 3 BYTE POINTER 11400000 A00024 EQU CCWWORK+00000020 4 BYTE(S) 11410000 CCWD EQU CCWWORK+00000024 8 BYTE(S) 11420000 CCWF EQU CCWWORK+00000032 8 BYTE(S) 11430000 WRITEBUF EQU 00000000 120 BYTE(S) 11440000 DADBUF EQU 00000000 1 BYTE(S) 11450000 ORG @DATA 11460000 DS 00000004C 11470000 @L EQU 3 11480000 @DATD DSECT 11490000 CC3PLIST EQU @DATD+00000000 4 BYTE(S) ON WORD 11500000 FUNCTCOD EQU CC3PLIST+00000000 1 BYTE(S) 11510000 CC3UCB EQU CC3PLIST+00000001 3 BYTE POINTER ON WORD+1 11520000 DS 00000008C 11530000 @TEMPS DS 0F 11540000 @TEMP3 DC F'0' 11550000 @TEMP4 DC F'0' 11560000 IGE0019I CSECT XM4924 11570000 * 11580000 *********************************************************************** 11590000 * READ SKIP AND READ REPEAT 11600000 CCWRDSKP CCW 2,*,X'30',80 READ SKIP M4502 11610000 CCWWRNEG CCW 1,*,X'60',1 WRTIE N M4502 11620000 * FORCE TO READ SEQUENCE 11630000 CCWWREOT CCW 1,*,X'60',1 WRITE EOT M4502 11640000 CCWRDEOT CCW 2,*,X'60',1 READ M4502 11650000 * ENABLE 11660000 CCWENABL CCW X'27',0,X'60',1 ENABLE M4502 11670000 *********************************************************************** 11680000 * 11690000 * 11700000 *********************************************************************** 11710000 *********************************************************************** 11720000 * 11730000 @DATD DSECT XM4924 11740000 @DATD DSECT 11750000 @DATEND EQU * 11760000 IGE0019I CSECT , 11770000 @9F2 EQU ERRORA3X 11780000 @9F1 EQU ERRORSNO 11790000 @9EE EQU ERRORSNO 11800000 @9ED EQU ERRORIRR 11810000 @9EC EQU ERRORSNO 11820000 @9EB EQU ERRORA3X 11830000 @9EA EQU ERRORA3X 11840000 @9E8 EQU NOERITOK 11850000 END 11860000