TITLE 'IFDOLT32 TEST DECODE' 00010000 TITLE 'IFDOLT32 TEST DECODE' 00020000 LCLA &T,&SPN 0002 00030000 .@001 ANOP 0002 00040000 IFDOLT32 CSECT , 0002 00050000 BC 15,24(0,@F) 00060000 DC C'IFDOLT32 14 FEB 78' 0002 00070000 STM @E,@C,12(@D) 0002 00080000 BALR @B,0 0002 00090000 @PSTART DS 0H 0002 00100000 USING @PSTART+00000,@B 0002 00110000 ST @D,@SAV001+4 0002 00120000 LA @F,@SAV001 0002 00130000 ST @F,8(0,@D) 0002 00140000 LR @D,@F 0002 00150000 * GEN(USING CHASCT,2); 00160000 USING CHASCT,2 00170000 DS 0H 00180000 * GENERATE DATA; 00190000 * /************************************************************ 00200000 * /* REGISTERS * 00210000 * /************************************************************ 00220000 * DCL R1 REG(1) PTR(31); /* REGISTER 1. * 00230000 * DCL R2 REG(2) PTR(31); /* REGISTER 2. * 00240000 * DCL I REG(3) PTR(24); /* REGISTER 3. * 00250000 * DCL RETCODE REG(3) PTR(24); /* REGISTER 3. * 00260000 * DCL R5 REG(5) PTR(31); /* REGISTER 5. * 00270000 * DCL R6 REG(6) PTR(31); /* REGISTER 6. * 00280000 * DCL R7 REG(7) PTR(31); /* REGISTER 7. * 00290000 * DCL SECCNTR REG(7) PTR(24); /* REGISTER 7. * 00300000 * DCL R8 REG(8) PTR(31); /* REGISTER 8. * 00310000 * DCL R13 REG(13) PTR(31); /* REGISTER 13. * 00320000 * DCL R14 REG(14) PTR(31); /* REGISTER 14. * 00330000 * DCL RC REG(15) PTR(24); /* REGISTER 15. * 00340000 * DCL R15 REG(15) PTR(31); /* REGISTER 15. * 00350000 * /************************************************************ 00360000 * /* SAVE AREAS * 00370000 * /************************************************************ 00380000 * DCL 1 MYSAVE BASED(R13), 00390000 * 3 * CHAR(4), 00400000 * 3 YOURR13 PTR(31); 00410000 * DCL 1 YOURSAVE BASED(YOURR13), 00420000 * 3 * CHAR(12), 00430000 * 3 YOURR14 PTR(31); 00440000 * /************************************************************ 00450000 * /* SECTION CONTROL TABLE * 00460000 * /************************************************************ 00470000 * DCL CHASCT CHAR(88) GENERATED; 00480000 * DCL 1 SCT BASED(ADDR(CHASCT)), /*--------SCT FORMAT---------* 00490000 * 3 * CHAR(4), /* NOT LOOKED AT. * 00500000 * 3 RTNFLDXX CHAR(2), /* NORMAL ROUTINE SELECTION * 00510000 * /* FIELD. * 00520000 * 3 * CHAR(27), /* NOT LOOKED AT. * 00530000 * 3 EXPGMFLG CHAR(1), /* EXECUTIVE PROGRAM FLAGS. * 00540000 * 5 * BIT(2), /* NOT LOOKED AT. * 00550000 * 5 RTNSLCTN BIT(1), /* ROUTINES SELECTED FLAG. * 00560000 * 3 * CHAR(6), /* NOT LOOKED AT. * 00570000 * 3 EXPANDED CHAR(30); /* EXPANDED ROUTINE SELECTION* 00580000 * /* FIELD. * 00590000 * /************************************************************ 00600000 * /* MESSAGES * 00610000 * /************************************************************ 00620000 * DCL IFDMSG32 LABEL NONLOCAL EXTERNAL; 00630000 * DCL 1 MSGPTR BASED(R1), /* MESSAGE POINTERS. * 00640000 * 3 MSGPTR12 PTR(31), /* POINTER TO MESSAGE IFD112I* 00650000 * 3 MSGPTR61 PTR(31), /* POINTER TO MESSAGE IFD161I* 00660000 * 3 MSGPTR55 PTR(31); /* POINTER TO MESSAGE IFD155I* 00670000 * DCL 1 MSG112 CHAR(41) BASED(R1),/* MESSAGE IFD112I FORMAT. * 00680000 * 3 * CHAR(4), /* LENGTH AND FLAGS. * 00690000 * 3 MSG112I CHAR(37); /* MESSAGE TEXT. * 00700000 * /************************************************************ 00710000 * /* SECTION LIST * 00720000 * /************************************************************ 00730000 * DCL SECLST CHAR(138) GENERATED; 00740000 * DCL 1 SECLIST BASED(ADDR(SECLST)),/*---SECLST FORMAT--------* 00750000 * 3 NUMENTRY FIXED(15), /* NUMBER OF SECTIONS IN LIST* 00760000 * 3 PREFIXID CHAR(5), /* PREFIX AND TEST TYPE. * 00770000 * 5 PREFIX CHAR(1), /* TEST PREFIX. * 00780000 * 5 ID CHAR(4), /* TEST ID OR TEST TYPE. * 00790000 * 3 SECLST7 CHAR(5); /* ENTRIES BEGIN HERE. * 00800000 * DCL 1 SECLSTXX BASED(R8), /*-------ENTRY FORMAT--------* 00810000 * 3 TSTSECTN CHAR(3), /* SECTION NAME. * 00820000 * 5 TSTSCTN3 CHAR(3), /* SECTION NAME OF LENGTH 3. * 00830000 * 7 TSTSCTN2 CHAR(2), /* SECTION NAME OF LENGTH 2. * 00840000 * 8 TSTSCTN1 CHAR(1),/* SECTION NAME OF LENGTH 1. * 00850000 * 3 SECLNGTH CHAR(2); /* LENGTH OF SECTION. * 00860000 * DCL 1 DOUBLEWD BDY(DWORD) CHAR(8), 00870000 * 3 SAVR14 PTR(31); 00880000 * DCL LET1PTR PTR(31); /* POINTER TO LETTER IN ALPHABET */ 00890000 * /* THAT MATCHES LAST LETTER IN */ 00900000 * /* FSTSEC. */ 00910000 * DCL LET2PTR PTR(31); 00920000 * DCL LET3PTR PTR(31); 00930000 * DCL J FIXED(15); 00940000 * DCL ALPHABET CHAR(26) 00950000 * INITIAL('ABCDEFGHIJKLMNOPQRSTUVWXYZ'); 00960000 * DCL LETTER CHAR(1) BASED(R6); 00970000 * DCL NUMBERS CHAR(10) INITIAL('0123456789'); 00980000 * DCL NUMBER CHAR(1) BASED(R6); 00990000 * DCL 1 SWITCHES CHAR(1) INITIAL('00'X), 01000000 * 3 SECTIONS BIT(3), 01010000 * 5 SECT1 BIT(1), /* TEST SECTION OF LENGTH 1 */ 01020000 * 5 SECT2 BIT(1), /* TEST SECTION OF LENGTH 2 */ 01030000 * 5 SECT3 BIT(1), /* TEST SECTION OF LENGTH 3 */ 01040000 * 3 EXPFLG BIT(1), 01050000 * 3 DUBNUM BIT(1), 01060000 * 3 TRINUM BIT(1); 01070000 * DCL 1 FSTSEC CHAR(3), 01080000 * 3 * CHAR(1), 01090000 * 3 FSTSEC1 CHAR(2), 01100000 * 5 FSTSECT1 CHAR(1), 01110000 * 5 FSTSEC2 CHAR(1); 01120000 * DCL 1 LSTSEC CHAR(3), 01130000 * 3 * CHAR(1), 01140000 * 3 LSTSEC1 CHAR(2), 01150000 * 5 * CHAR(1), 01160000 * 5 LSTSEC2 CHAR(1); 01170000 * DCL ERRCODE CHAR(2); 01180000 * DCL INPUTBUF CHAR(4) BASED(R5); 01190000 * DCL SOSPBUF CHAR(6) BASED(R5);/* SOSP CHAR BUFFER M4833* 01200000 * DCL RTNFIELD CHAR(1) BASED(R7); 01210000 * DCL PGMTAB CHAR(8) GENERATED; 01220000 * DCL PGMTBL CHAR(8) BASED(ADDR(PGMTAB)); 01230000 * DCL INBUFPTR PTR(31) GENERATED; 01240000 * DCL REDEFINE PTR(31) GENERATED; 01250000 * DCL ADSVAREA PTR(31) GENERATED; 01260000 * DCL HRTSEL FIXED(15) GENERATED; 01270000 * DCL UNITUSE CHAR(1) GENERATED; 01280000 * DCL SECTUSE CHAR(1) GENERATED; 01290000 * /************************************************************ 01300000 * /* SWITCHES * 01310000 * /************************************************************ 01320000 * DCL CESWT CHAR(1) GENERATED; 01330000 * DCL 1 OLTEPSW CHAR(1) BASED(ADDR(CESWT)), 01340000 * 3 LEGALTST BIT(1), 01350000 * 3 * BIT(4), 01360000 * 3 REINT BIT(1); 01370000 * DCL CESWT1 CHAR(1) GENERATED; 01380000 * DCL 1 OLTEPSW1 CHAR(1) BASED(ADDR(CESWT1)), 01390000 * 3 RTNFLD BIT(1); 01400000 * RESTRICT(2,3,5,6,7,8,9); 01410000 * R5=INBUFPTR+1; /* GET INBUFR POINTER */ 01420000 LA @5,1 0057 01430000 A @5,INBUFPTR 0057 01440000 * IF INPUTBUF(1)^='/' THEN /* IS THE CHAR IN INBUFR+0 A /. */ 01450000 CLI 0(@5),C'/' 0058 01460000 * GO TO CECTST04; /* NO, CONTINUE TO DECODE */ 01470000 BC 07,CECTST04 0059 01480000 * IF LEGALTST='1'B THEN /* WAS THERE A LEGAL TEST ENTRY */ 01490000 TM OLTEPSW,B'10000000' 0060 01500000 * GO TO CECTST99; /* YES, RETURN TO CALLER */ 01510000 BC 01,CECTST99 0061 01520000 * ERRCODE='04'; /* NO, SET ERROR CODE -04- IN */ 01530000 MVC ERRCODE(2),@C3 0062 01540000 * /* ERROR MESSAGE IFD112I AND */ 01550000 * /* RETURN TO REDEFINE TEST */ 01560000 * RESTRICT(1); 01570000 * CECTST03: 01580000 * /************************************************************ 01590000 * /* * 01600000 * /* PWTO MESSAGES IFD112I AND IFD161I * 01610000 * /* * 01620000 * /************************************************************ 01630000 * R1=ADDR(IFDMSG32); /* GET POINTER TO MESSAGE MODULE * 01640000 CECTST03 L @4,@V1 ADDRESS OF IFDMSG32 0064 01650000 LR @1,@4 0064 01660000 * R1=MSGPTR12; /* GET POINTER TO MESSAGE IFD112I.* 01670000 L @1,0(0,@1) 0065 01680000 * MSG112I(35:36)=ERRCODE; /* PUT ERROR CODE IN MSG. 21051* 01690000 MVC 38(2,@1),ERRCODE 0066 01700000 * GEN(PWTO REG=(1)); /* PRINT MESSAGE. * 01710000 PWTO REG=(1) 01720000 DS 0H 01730000 * R1=ADDR(IFDMSG32); /* GET POINTER TO MESSAGE MODULE * 01740000 LR @1,@4 0068 01750000 * R1=MSGPTR61; /* GET POINTER TO MESSAGE IFD161I * 01760000 L @1,4(0,@1) 0069 01770000 * RELEASE(1); 01780000 * GEN(PWTO REG=(1)); /* PRINT MESSAGE. * 01790000 PWTO REG=(1) 01800000 DS 0H 01810000 * YOURR14=REDEFINE; /* CHANGE RETURN POINT SO THAT */ 01820000 L @1,4(0,@D) 0072 01830000 MVC 12(4,@1),REDEFINE 0072 01840000 * /* TEST CAN BE REDEFINED. */ 01850000 * RETURN; /* RETURN TO CALLER. */ 01860000 BC 15,@EL01 0073 01870000 * CECTST04: 01880000 * /************************************************************ 01890000 * /* * 01900000 * /* DECODE THE TESTS ENTERED * 01910000 * /* * 01920000 * /************************************************************ 01930000 * SECTUSE='00'X; /* CLEAR SECTIONS-USED COUNTER */ 01940000 CECTST04 MVI SECTUSE,X'00' 0074 01950000 * UNITUSE='00'X; /* CLEAR UNIT USE COUNTER. */ 01960000 MVI UNITUSE,X'00' 0075 01970000 * SECLST(1)=' '; /* INITIALIZE SECLST AREA. */ 01980000 MVI SECLST,C' ' 0076 01990000 * SECLST(2:138)=SECLST(1:137); 02000000 MVC SECLST+1(137),SECLST 0077 02010000 * REINT='1'B; /* SET REINT INDICATOR ON */ 02020000 OI OLTEPSW,B'00000100' 0078 02030000 * LEGALTST='0'B; /* CLEAR LEGALTST INDICATOR */ 02040000 NI OLTEPSW,B'01111111' 0079 02050000 * RTNFLD='0'B; /* CLEAR ROUTINE FIELD INDICATOR */ 02060000 NI OLTEPSW1,B'01111111' 0080 02070000 * RTNSLCTN='0'B; /* CLEAR ROUTINES SELECTED BIT IN * 02080000 NI SCT+33,B'11011111' 0081 02090000 * /* EXECUTIVE PROGRAM FLAGS. * 02100000 * RTNFLDXX=RTNFLDXX&&RTNFLDXX; /* CLEAR ROUTINE FIELDS OF */ 02110000 XC SCT+4(2),SCT+4 0082 02120000 * /* SCT(NORMAL & EXPANDED) */ 02130000 * EXPANDED=EXPANDED&&EXPANDED; 02140000 XC SCT+40(30),SCT+40 0083 02150000 * SECCNTR=0; /* INITIALIZE SECTION COUNTER. */ 02160000 SR @7,@7 0084 02170000 * R8=ADDR(SECLST7); /* INITIALIZE REG. 8. */ 02180000 LA @8,SECLIST+7 0085 02190000 * PREFIX='T'; /* DEFAULT PREFIX IS T */ 02200000 MVI SECLIST+2,C'T' 0086 02210000 * IF INPUTBUF(1)='T'| /* IS THE TYPE OF ROOT MODULE */ 02220000 * INPUTBUF(1)='P'| /* PRESENT. YES, SET PREFIX */ 02230000 * INPUTBUF(1)='N'| /* EQUAL TO IT AND INCREMENT */ 02240000 * INPUTBUF(1)='R' THEN /* INBUFR PTR BY ONE. NO, USE */ 02250000 CLI 0(@5),C'T' 0087 02260000 BC 08,@9FF 0087 02270000 CLI 0(@5),C'P' 0087 02280000 BC 08,@9FE 0087 02290000 CLI 0(@5),C'N' 0087 02300000 BC 08,@9FD 0087 02310000 CLI 0(@5),C'R' 0087 02320000 BC 07,@9FC 0087 02330000 * DO; /* THE DEFAULT PREFIX */ 02340000 @9FD EQU * 0088 02350000 @9FE EQU * 0088 02360000 * PREFIX=INPUTBUF(1); 02370000 @9FF MVC SECLIST+2(1),0(@5) 0089 02380000 * R5=R5+1; 02390000 AH @5,@D1 0090 02400000 * END; 02410000 * IF SOSPBUF='SOSPC/' THEN /*SOSPC IN TEST FIELD @ZA29758* 02420000 @9FC CLC 0(6,@5),@C11 0092 02430000 * GO TO CECTST13; /* GOOD TEST ENTRY M4833* 02440000 BC 08,CECTST13 0093 02450000 * CECTST11: 02460000 * /************************************************************ 02470000 * /* * 02480000 * /* IS TEST ID NUMERIC * 02490000 * /* * 02500000 * /************************************************************ 02510000 * DO J=1 TO 4; /* ARE ALL CHARACTERS IN */ 02520000 CECTST11 LA @F,1 0094 02530000 STH @F,J 0094 02540000 * R6=ADDR(NUMBERS); /* ID NUMERIC. NO, SET */ 02550000 @DO9FB LA @6,NUMBERS 0095 02560000 * DO I=10 TO 1 BY -1; /* ERROR CODE TO -05- */ 02570000 LA @3,10 0096 02580000 * IF INPUTBUF(J)=NUMBER THEN /* AND PRINT ERROR */ 02590000 @DO9F7 LH @1,J 0097 02600000 LA @A,0(@1,@5) 0097 02610000 BCTR @A,0 0097 02620000 CLC 0(1,@A),0(@6) 0097 02630000 * GO TO CECTST12; /* MESSAGE IFD112I */ 02640000 BC 08,CECTST12 0098 02650000 * R6=R6+1; /* YES, CONTINUE TO */ 02660000 AH @6,@D1 0099 02670000 * END; /* DECODE */ 02680000 * ERRCODE='05'; 02690000 BCT @3,@DO9F7 0100 02700000 MVC ERRCODE(2),@C12 0101 02710000 * GO TO CECTST03; 02720000 BC 15,CECTST03 0102 02730000 * CECTST12: 02740000 * END; 02750000 * CECTST13: 02760000 * /************************************************************ 02770000 * /* * 02780000 * /* DECODE SECTIONS ENTERED, IF THERE ARE ANY. * 02790000 * /* IF NONE ARE ENTERED, USE DEFAULT RANGE A-Z. * 02800000 * /* * 02810000 * /************************************************************ 02820000 * ID=INPUTBUF; /* SAVE ID */ 02830000 CECTST12 LH @F,J 0103 02840000 AH @F,@D1 0103 02850000 @DO9FA STH @F,J 0103 02860000 CH @F,@D2 0103 02870000 BC 12,@DO9FB 0103 02880000 CECTST13 MVC SECLIST+3(4),0(@5) 0104 02890000 * R5=R5+4; /* INCREMENT INBUFR POINTER BY 4 */ 02900000 AH @5,@D2 0105 02910000 * IF INPUTBUF(1)='/' THEN /* IS CHAR IN INBUFR+0 A SLASH.*/ 02920000 CLI 0(@5),C'/' 0106 02930000 BC 07,@9F3 0106 02940000 * DO; /* YES, SET BIT INDICATING */ 02950000 * SECTIONS='100'B; /* TEST SECTION HAS A LENGTH */ 02960000 OI SWITCHES,B'10000000' 0108 02970000 NI SWITCHES,B'10011111' 0108 02980000 * /* OF ONE & SET DEFAULT RANGE */ 02990000 * FSTSEC=' A'; /* OF SECTIONS A-Z & SET */ 03000000 MVC FSTSEC(3),@C14 0109 03010000 * LSTSEC=' Z'; /* POINTER 1 TO ADDRESS OF 1ST*/ 03020000 MVC LSTSEC(3),@C15 0110 03030000 * LET1PTR=ADDR(ALPHABET); /* LETTER IN ALPHABET & GO TO */ 03040000 LA @F,ALPHABET 0111 03050000 ST @F,LET1PTR 0111 03060000 * GO TO CECTST29; /* ROUTINE THAT BUILDS SECLST */ 03070000 BC 15,CECTST29 0112 03080000 * END; 03090000 * CECTST14: 03100000 * /************************************************************ 03110000 * /* * 03120000 * /* DECODE THE ENTERED SECTIONS * 03130000 * /* * 03140000 * /************************************************************ 03150000 * FSTSEC=' '; /* INITIALIZE CONSTANTS */ 03160000 @9F3 EQU * 0114 03170000 CECTST14 MVC FSTSEC(3),@C16 0114 03180000 * LSTSEC=FSTSEC; /* TO DECODE SECTIONS */ 03190000 MVC LSTSEC(3),FSTSEC 0115 03200000 * R6=ADDR(ALPHABET); /* IS THE CHAR. IN INBUFR */ 03210000 LA @6,ALPHABET 0116 03220000 * DO I=26 TO 1 BY -1; /* ALPHABETIC. YES, SET */ 03230000 LA @3,26 0117 03240000 * IF INPUTBUF(1)=LETTER THEN /* POINTER TO IT AND */ 03250000 @DO9F2 CLC 0(1,@5),0(@6) 0118 03260000 BC 07,@9EE 0118 03270000 * DO; /* CONTINUE DECODING. NO */ 03280000 * LET1PTR=R6; /* SET ERROR CODE -06- AND*/ 03290000 ST @6,LET1PTR 0120 03300000 * GO TO CECTST15; /* PRINT ERROR MESSAGE */ 03310000 BC 15,CECTST15 0121 03320000 * END; /* IFD112I */ 03330000 * R6=R6+1; 03340000 @9EE AH @6,@D1 0123 03350000 * END; 03360000 * GO TO CECTST05; 03370000 BCT @3,@DO9F2 0124 03380000 BC 15,CECTST05 0125 03390000 * CECTST15:/* DOES SECTION NAME HAVE LENGTH TWO */ 03400000 * SECTIONS='000'B; /* CLEAR BITS THAT INDICATE THE */ 03410000 CECTST15 NI SWITCHES,B'00011111' 0126 03420000 * /* LENGTH OF THE TEST SECTION */ 03430000 * R6=ADDR(ALPHABET); /* IS THE CHAR IN INBUFR+1 */ 03440000 LA @6,ALPHABET 0127 03450000 * DO I=26 TO 1 BY -1; /* ALPHABETIC. YES, SET A */ 03460000 LA @3,26 0128 03470000 * IF INPUTBUF(2)=LETTER THEN /* POINTER TO IT AND CONTINUE*/ 03480000 @DO9ED CLC 1(1,@5),0(@6) 0129 03490000 BC 07,@9E9 0129 03500000 * DO; /* TO DECODE. */ 03510000 * LET2PTR=LET1PTR; 03520000 MVC LET2PTR(4),LET1PTR 0131 03530000 * LET1PTR=R6; 03540000 ST @6,LET1PTR 0132 03550000 * GO TO CECTST21; 03560000 BC 15,CECTST21 0133 03570000 * END; 03580000 * R6=R6+1; 03590000 @9E9 AH @6,@D1 0135 03600000 * END; 03610000 * SECT1='1'B; /* NO, SET BIT INDICATING TEST */ 03620000 BCT @3,@DO9ED 0136 03630000 OI SWITCHES,B'10000000' 0137 03640000 * /* SECTION OF LENGTH ONE */ 03650000 * FSTSEC2=INPUTBUF(1); /* RETAIN SECTION NAME. */ 03660000 MVC FSTSEC+2(1),0(@5) 0138 03670000 * IF INPUTBUF(2)='-' THEN /* IS THE CHAR. IN INBUFR+1 */ 03680000 CLI 1(@5),C'-' 0139 03690000 * GO TO CECTST17; /* A HYPHEN. YES,CONTINUE */ 03700000 BC 08,CECTST17 0140 03710000 * /* DECODING. NO, SET LAST */ 03720000 * CECTST16:/* ROUTINE FOR INCLUSIVE SECTIONS OF LENGTH ONE */ 03730000 * LSTSEC2=INPUTBUF(1); /* SECTION EQUAL TO FIRST */ 03740000 CECTST16 MVC LSTSEC+2(1),0(@5) 0141 03750000 * /* SECTION */ 03760000 * R5=R5+1; /* INCREMENT INBUFR PTR */ 03770000 AH @5,@D1 0142 03780000 * GO TO CECTST29; /* GO TO ROUTINE THAT */ 03790000 BC 15,CECTST29 0143 03800000 * /* BUILDS SECLST */ 03810000 * CECTST17: 03820000 * /************************************************************ 03830000 * /* * 03840000 * /* IS A VALID INCLUSIVE RANGE ENTERED * 03850000 * /* * 03860000 * /************************************************************ 03870000 * R6=ADDR(ALPHABET); /* IS THE CHAR. IN INBUFR+2 */ 03880000 CECTST17 LA @6,ALPHABET 0144 03890000 * DO I=26 TO 1 BY -1; /* ALPHABETIC. NO, SET ERROR*/ 03900000 LA @3,26 0145 03910000 * IF INPUTBUF(3)=LETTER THEN /* CODE 07 AND PRINT ERROR*/ 03920000 @DO9E8 CLC 2(1,@5),0(@6) 0146 03930000 * GO TO CECTST19; /* MESSAGE IFD112I. YES, */ 03940000 BC 08,CECTST19 0147 03950000 * R6=R6+1; /* CONTINUE TO DECODE */ 03960000 AH @6,@D1 0148 03970000 * END; 03980000 * CECTST18: 03990000 * /************************************************************ 04000000 * /* * 04010000 * /* ERROR, INVALID RANGE OF SECTIONS * 04020000 * /* * 04030000 * /************************************************************ 04040000 * ERRCODE='07'; 04050000 BCT @3,@DO9E8 0149 04060000 CECTST18 MVC ERRCODE(2),@C19 0150 04070000 * GO TO CECTST03; 04080000 BC 15,CECTST03 0151 04090000 * CECTST19:/* IS SECTION NAME OF INCLUSIVE RANGE LENGTH TWO */ 04100000 * R5=R5+2; /* INCREMENT INBUFR PTR */ 04110000 CECTST19 AH @5,@D3 0152 04120000 * R6=ADDR(ALPHABET); /* IS THE CHAR. IN INBUFR+1 */ 04130000 LA @6,ALPHABET 0153 04140000 * DO I=26 TO 1 BY -1; /* ALPHABETIC. NO, GO TO */ 04150000 LA @3,26 0154 04160000 * IF INPUTBUF(2)=LETTER THEN /* ROUTINE FOR INCLUSIVE */ 04170000 @DO9E4 CLC 1(1,@5),0(@6) 0155 04180000 * GO TO CECTST20; /* SECTIONS OF LENGTH ONE */ 04190000 BC 08,CECTST20 0156 04200000 * R6=R6+1; /* YES, CONTINUE TO DECODE */ 04210000 AH @6,@D1 0157 04220000 * END; 04230000 * GO TO CECTST16; /* CONTINUE DECODING. */ 04240000 BCT @3,@DO9E4 0158 04250000 BC 15,CECTST16 0159 04260000 * CECTST20:/* IS SECTION NAME OF INCLUSIVE RANGE LENGTH THREE */ 04270000 * R6=ADDR(ALPHABET); /* IS THE CHAR. IN INBUFR+2 */ 04280000 CECTST20 LA @6,ALPHABET 0160 04290000 * DO I=26 TO 1 BY -1; /* ALPHABETIC. NO,GO TO */ 04300000 LA @3,26 0161 04310000 * IF INPUTBUF(3)=LETTER THEN /* ROUTINE FOR INCLUSIVE */ 04320000 @DO9E0 CLC 2(1,@5),0(@6) 0162 04330000 * GO TO CECTST26; /* SECTIONS OF LENGTH TWO */ 04340000 BC 08,CECTST26 0163 04350000 * R6=R6+1; /* YES,GO TO ROUTINE FOR */ 04360000 AH @6,@D1 0164 04370000 * END; /* INCLUSIVE SECTIONS OF */ 04380000 * GO TO CECTST22; /* LENGTH THREE. */ 04390000 BCT @3,@DO9E0 0165 04400000 BC 15,CECTST22 0166 04410000 * CECTST21:/* DOES SECTION NAME HAVE LENGTH THREE */ 04420000 * R6=ADDR(ALPHABET); /* IS THE CHAR. IN INBUFR+2 */ 04430000 CECTST21 LA @6,ALPHABET 0167 04440000 * DO I=26 TO 1 BY -1; /* ALPHABETIC. YES, SET */ 04450000 LA @3,26 0168 04460000 * IF INPUTBUF(3)=LETTER THEN /* POINTER TO IT AND */ 04470000 @DO9DC CLC 2(1,@5),0(@6) 0169 04480000 BC 07,@9D8 0169 04490000 * DO; /* CONTINUE TO DECODE */ 04500000 * LET3PTR=LET2PTR; 04510000 MVC LET3PTR(4),LET2PTR 0171 04520000 * LET2PTR=LET1PTR; 04530000 MVC LET2PTR(4),LET1PTR 0172 04540000 * LET1PTR=R6; 04550000 ST @6,LET1PTR 0173 04560000 * GO TO CECTST25; 04570000 BC 15,CECTST25 0174 04580000 * END; 04590000 * R6=R6+1; 04600000 @9D8 AH @6,@D1 0176 04610000 * END; 04620000 * SECTIONS='010'B; /* NO, SET BIT INDICATING */ 04630000 BCT @3,@DO9DC 0177 04640000 OI SWITCHES,B'01000000' 0178 04650000 NI SWITCHES,B'01011111' 0178 04660000 * /* TEST SECTION OF LENGTH */ 04670000 * /* TWO & SAVE THE SECTION */ 04680000 * FSTSEC1=INPUTBUF(1:2); /* IN FSTSEC. */ 04690000 MVC FSTSEC+1(2),0(@5) 0179 04700000 * IF INPUTBUF(3)='-' THEN /* IS CHAR. IN INBUFR+2 A -.*/ 04710000 CLI 2(@5),C'-' 0180 04720000 * GO TO CECTST23; /* YES, CONTINUE TO DECODE */ 04730000 BC 08,CECTST23 0181 04740000 * CECTST22:/* ROUTINE FOR INCLUSIVE SECTIONS OF LENGTH TWO */ 04750000 * LSTSEC1=INPUTBUF(1:2); /* PUT SECTION IN LSTSEC */ 04760000 CECTST22 MVC LSTSEC+1(2),0(@5) 0182 04770000 * R5=R5+2; /* INCREMENT INBUFR POINTER */ 04780000 AH @5,@D3 0183 04790000 * GO TO CECTST29; /* GO TO THE ROUTINE FOR */ 04800000 BC 15,CECTST29 0184 04810000 * /* BUILDING SECLST */ 04820000 * CECTST23:/* IS INCLUSIVE RANGE VALID */ 04830000 * R5=R5+3; /* INCREMENT INBUFR PTR */ 04840000 CECTST23 AH @5,@D4 0185 04850000 * DO J=1 TO 2; /* ARE THE CHAR. IN INBUFR AND */ 04860000 LA @F,1 0186 04870000 STH @F,J 0186 04880000 * R6=ADDR(ALPHABET); /* INBUFR+1 ALPHABETIC. YES, */ 04890000 @DO9D7 LA @6,ALPHABET 0187 04900000 * DO I=26 TO 1 BY -1; /* CONTINUE TO DECODE. NO, SET */ 04910000 LA @3,26 0188 04920000 * IF INPUTBUF(J)=LETTER THEN /* ERROR CODE TO -07- */ 04930000 @DO9D3 LH @1,J 0189 04940000 LA @A,0(@1,@5) 0189 04950000 BCTR @A,0 0189 04960000 CLC 0(1,@A),0(@6) 0189 04970000 * GO TO CECTST24; /* AND PRINT ERROR */ 04980000 BC 08,CECTST24 0190 04990000 * R6=R6+1; /* MESSAGE IFD112I */ 05000000 AH @6,@D1 0191 05010000 * END; 05020000 * GO TO CECTST18; 05030000 BCT @3,@DO9D3 0192 05040000 BC 15,CECTST18 0193 05050000 * CECTST24: 05060000 * END; 05070000 * R6=ADDR(ALPHABET); /* IS THE CHAR. IN INBUFR+2 */ 05080000 CECTST24 LH @F,J 0194 05090000 AH @F,@D1 0194 05100000 @DO9D6 STH @F,J 0194 05110000 CH @F,@D3 0194 05120000 BC 12,@DO9D7 0194 05130000 LA @6,ALPHABET 0195 05140000 * DO I=26 TO 1 BY -1; /* ALPHABETIC. YES,GO TO THE*/ 05150000 LA @3,26 0196 05160000 * IF INPUTBUF(3)=LETTER THEN /* ROUTINE FOR INCLUSIVE */ 05170000 @DO9CF CLC 2(1,@5),0(@6) 0197 05180000 * GO TO CECTST26; /* SECTIONS OF LENGTH THREE */ 05190000 BC 08,CECTST26 0198 05200000 * R6=R6+1; /* NO, SEE IF INPUTBUF(1:2) */ 05210000 AH @6,@D1 0199 05220000 * END; /* IS > FSTSEC+1. YES, */ 05230000 * IF INPUTBUF(1:2)>FSTSEC1 THEN /* CONTINUE TO DECODE. NO, */ 05240000 BCT @3,@DO9CF 0200 05250000 CLC 0(2,@5),FSTSEC+1 0201 05260000 * GO TO CECTST22; /* SET ERROR CODE -07- AND */ 05270000 BC 02,CECTST22 0202 05280000 * GO TO CECTST18; /* PRINT ERROR MESSAGE IFD112I*/ 05290000 BC 15,CECTST18 0203 05300000 * CECTST25:/* SECTION NAME OF LENGTH THREE */ 05310000 * SECTIONS='001'B; /* SET BIT TO INDICATE SECTION */ 05320000 CECTST25 OI SWITCHES,B'00100000' 0204 05330000 NI SWITCHES,B'00111111' 0204 05340000 * /* NAME OF LENGTH THREE */ 05350000 * FSTSEC=INPUTBUF(1:3); /* SAVE SECTION NAME */ 05360000 MVC FSTSEC(3),0(@5) 0205 05370000 * IF INPUTBUF(4)='-' THEN /* IS THE CHAR. IN INBUFR+3 A */ 05380000 CLI 3(@5),C'-' 0206 05390000 * GO TO CECTST27; /* HYPHEN. YES,CONTINUE TO DECODE * 05400000 BC 08,CECTST27 0207 05410000 * /* NO, GO TO ROUTINE THAT * 05420000 * /* BUILDS SECLST * 05430000 * CECTST26:/* ROUTINE FOR INCLUSIVE SECTIONS OF LENGTH THREE */ 05440000 * LSTSEC=INPUTBUF(1:3); /* SET LSTSEC EQUAL TO SECTION*/ 05450000 CECTST26 MVC LSTSEC(3),0(@5) 0208 05460000 * /* IN INBUFR */ 05470000 * R5=R5+3; /* INCREMENT INBUFR PTR */ 05480000 AH @5,@D4 0209 05490000 * GO TO CECTST29; /* GO TO ROUTINE THAT */ 05500000 BC 15,CECTST29 0210 05510000 * /* BUILDS SECLST */ 05520000 * CECTST27:/* IS SECTION NAME OF INCLUSIVE RANGE LENGTH THREE */ 05530000 * /* AND IS IT A VALID INCLUSIVE RANGE */ 05540000 * R5=R5+4; /* INCREMENT INBUFR PTR */ 05550000 CECTST27 AH @5,@D2 0211 05560000 * DO J=1 TO 3; /* ARE THE CHAR. INBUFR,INBUFR+1 */ 05570000 LA @F,1 0212 05580000 STH @F,J 0212 05590000 * R6=ADDR(ALPHABET); /* AND INBUFR+2 ALPHABETIC. YES */ 05600000 @DO9CB LA @6,ALPHABET 0213 05610000 * DO I=26 TO 1 BY -1; /* CONTINUE TO DECODE. NO,SET */ 05620000 LA @3,26 0214 05630000 * IF INPUTBUF(J)=LETTER THEN /* ERROR CODE -07- AND */ 05640000 @DO9C7 LH @1,J 0215 05650000 LA @A,0(@1,@5) 0215 05660000 BCTR @A,0 0215 05670000 CLC 0(1,@A),0(@6) 0215 05680000 * GO TO CECTST28; /* PRINT ERROR MESSAGE */ 05690000 BC 08,CECTST28 0216 05700000 * R6=R6+1; /* IFD112I */ 05710000 AH @6,@D1 0217 05720000 * END; 05730000 * GO TO CECTST18; 05740000 BCT @3,@DO9C7 0218 05750000 BC 15,CECTST18 0219 05760000 * CECTST28: 05770000 * END; 05780000 * GO TO CECTST26; /* GO TO ROUTINE FOR INCLUSIVE*/ 05790000 CECTST28 LH @F,J 0220 05800000 AH @F,@D1 0220 05810000 @DO9CA STH @F,J 0220 05820000 CH @F,@D4 0220 05830000 BC 12,@DO9CB 0220 05840000 BC 15,CECTST26 0221 05850000 * /* SECTIONS OF LENGTH THREE. */ 05860000 * CECTST29: 05870000 * /************************************************************ 05880000 * /* * 05890000 * /* ROUTINE FOR BUILDING SECLST * 05900000 * /* * 05910000 * /************************************************************ 05920000 * IF FSTSEC>LSTSEC THEN /* IS INCLUSIVE RANGE VALID. */ 05930000 CECTST29 CLC FSTSEC(3),LSTSEC 0222 05940000 * GO TO CECTST18; /* NO, PRINT ERROR MESSAGE */ 05950000 BC 02,CECTST18 0223 05960000 * /* IFD112I WITH ERROR CODE 07.*/ 05970000 * IF SECCNTR=26 THEN /* IS SECTION COUNTER 26. YES,*/ 05980000 CH @7,@D5 0224 05990000 * GO TO CECTST06; /* FIND SLASH AND PRINT */ 06000000 BC 08,CECTST06 0225 06010000 * /* MESSAGE INDICATING MORE */ 06020000 * /* THAN 26 SECTIONS SPECIFIED */ 06030000 * IF SECT1='1'B THEN /* PUT SECTION NAME IN SECLST. */ 06040000 TM SWITCHES,B'10000000' 0226 06050000 BC 12,@9C3 0226 06060000 * TSTSCTN1=FSTSEC2; 06070000 MVC 0(1,@8),FSTSEC+2 0227 06080000 * IF SECT2='1'B THEN 06090000 @9C3 TM SWITCHES,B'01000000' 0228 06100000 BC 12,@9C2 0228 06110000 * TSTSCTN2=FSTSEC1; 06120000 MVC 0(2,@8),FSTSEC+1 0229 06130000 * IF SECT3='1'B THEN 06140000 @9C2 TM SWITCHES,B'00100000' 0230 06150000 BC 12,@9C1 0230 06160000 * TSTSCTN3=FSTSEC; 06170000 MVC 0(3,@8),FSTSEC 0231 06180000 * SECLNGTH=SECLNGTH&&SECLNGTH; /* ZERO SECTION LENGTH. */ 06190000 @9C1 XC 3(2,@8),3(@8) 0232 06200000 * SECCNTR=SECCNTR+1; /* INCREMENT SECTION COUNTER */ 06210000 LA @7,1(0,@7) 0233 06220000 * R8=R8+5; /* UPDATE SECLST POINTER. */ 06230000 AH @8,@D6 0234 06240000 * IF LSTSEC=FSTSEC THEN /* HAS THIS BEEN FULLY DECODED */ 06250000 CLC LSTSEC(3),FSTSEC 0235 06260000 * GO TO CECTST34; /* YES, CONTINUE TO DECODE */ 06270000 BC 08,CECTST34 0236 06280000 * IF SECT1^='1'B THEN /* DOES THE SECTION NAME HAVE */ 06290000 TM SWITCHES,B'10000000' 0237 06300000 * GO TO CECTST31; /* LENGTH ONE. NO, FIND HOW */ 06310000 BC 12,CECTST31 0238 06320000 * /* LONG IT IS. */ 06330000 * IF FSTSEC2='Z' THEN /* YES, SEE IF AN UPDATE MUST */ 06340000 CLI FSTSEC+2,C'Z' 0239 06350000 BC 07,@9C0 0239 06360000 * DO; /* OCCUR. YES, PERFORM UPDATE*/ 06370000 * SECTIONS='010'B; /* NO, CONTINUE. */ 06380000 OI SWITCHES,B'01000000' 0241 06390000 NI SWITCHES,B'01011111' 0241 06400000 * FSTSEC=' AA'; 06410000 MVC FSTSEC(3),@C23 0242 06420000 * LET1PTR=ADDR(ALPHABET); 06430000 LA @F,ALPHABET 0243 06440000 ST @F,LET1PTR 0243 06450000 * LET2PTR=LET1PTR; 06460000 MVC LET2PTR(4),LET1PTR 0244 06470000 * GO TO CECTST29; 06480000 BC 15,CECTST29 0245 06490000 * END; 06500000 * CECTST30:/* UPDATE POINTER TO LAST LETTER IN SECTION NAME */ 06510000 * R6=LET1PTR+1; /* UPDATE POINTER TO POINT TO */ 06520000 @9C0 EQU * 0247 06530000 CECTST30 LA @6,1 0247 06540000 A @6,LET1PTR 0247 06550000 * FSTSEC2=LETTER; /* NEXT LETTER IN ALPHABET AND*/ 06560000 MVC FSTSEC+2(1),0(@6) 0248 06570000 * LET1PTR=R6; /* UPDATE FIRST SECTION TO */ 06580000 ST @6,LET1PTR 0249 06590000 * GO TO CECTST29; /* REFLECT CHANGE AND CONTINUE*/ 06600000 BC 15,CECTST29 0250 06610000 * CECTST31:/* UPDATE POINTERS TO SHOW SECTION HAS REACHED LENGTH THREE* 06620000 * IF SECT2^='1'B THEN /* DOES SECTION NAME HAVE */ 06630000 CECTST31 TM SWITCHES,B'01000000' 0251 06640000 * GO TO CECTST33; /* LENGTH ONE. NO, FIND */ 06650000 BC 12,CECTST33 0252 06660000 * /* HOW LONG IT IS. */ 06670000 * IF FSTSEC2^='Z' THEN /* YES, SEE IF LAST LETTER OF NAME* 06680000 CLI FSTSEC+2,C'Z' 0253 06690000 * GO TO CECTST30; /* IS A Z. NO,GO TO ROUTINE THAT * 06700000 BC 07,CECTST30 0254 06710000 * /* PERFORMS UPDATE OF LAST LETTER * 06720000 * IF FSTSEC(2)='Z' THEN /* YES, SEE IF MIDDLE LETTER OF * 06730000 CLI FSTSEC+1,C'Z' 0255 06740000 BC 07,@9BF 0255 06750000 * DO; /* NAME IS A Z. YES,PERFORM UPDATE* 06760000 * SECTIONS='001'B; /* TO SECTION OF LENGTH THREE. NO,* 06770000 OI SWITCHES,B'00100000' 0257 06780000 NI SWITCHES,B'00111111' 0257 06790000 * FSTSEC='AAA'; /* PERFORM REGULAR UPDATE FOR * 06800000 MVC FSTSEC(3),@C24 0258 06810000 * LET1PTR=ADDR(ALPHABET); /* MIDDLE LETTER OF SECTION NAME * 06820000 LA @F,ALPHABET 0259 06830000 ST @F,LET1PTR 0259 06840000 * LET2PTR=LET1PTR; 06850000 MVC LET2PTR(4),LET1PTR 0260 06860000 * LET3PTR=LET1PTR; 06870000 MVC LET3PTR(4),LET1PTR 0261 06880000 * GO TO CECTST29; 06890000 BC 15,CECTST29 0262 06900000 * END; 06910000 * CECTST32:/* UPDATE POINTER TO MIDDLE OR FIRST LETTER IN SECTION NAME* 06920000 * R6=LET2PTR+1; /* PERFORM UPDATE FOR MIDDLE */ 06930000 @9BF EQU * 0264 06940000 CECTST32 LA @6,1 0264 06950000 A @6,LET2PTR 0264 06960000 * FSTSEC(2)=LETTER; /* LETTER OF SECTION NAME */ 06970000 MVC FSTSEC+1(1),0(@6) 0265 06980000 * LET2PTR=R6; 06990000 ST @6,LET2PTR 0266 07000000 * FSTSEC2='A'; 07010000 MVI FSTSEC+2,C'A' 0267 07020000 * LET1PTR=ADDR(ALPHABET); 07030000 LA @F,ALPHABET 0268 07040000 ST @F,LET1PTR 0268 07050000 * GO TO CECTST29; /* CONTINUE */ 07060000 BC 15,CECTST29 0269 07070000 * CECTST33:/* UPDATE POINTERS FOR FIRST LETTER OF SECTION LENGTH THREE* 07080000 * IF FSTSEC2^='Z' THEN /* TRIPLE LETTER SECTION. IS LAST* 07090000 CECTST33 CLI FSTSEC+2,C'Z' 0270 07100000 * GO TO CECTST30; /* LETTER IN NAME A Z. NO, PERFORM* 07110000 BC 07,CECTST30 0271 07120000 * /* NORMAL UPDATE FOR LAST LETTER * 07130000 * /* IN TEST SECTION NAME * 07140000 * IF FSTSEC(2)^='Z' THEN /* IS MIDDLE LETTER IN NAME A Z */ 07150000 CLI FSTSEC+1,C'Z' 0272 07160000 * GO TO CECTST32; /* NO, PERFORM NORMAL UPDATE FOR*/ 07170000 BC 07,CECTST32 0273 07180000 * /* MIDDLE LETTER IN SECTION NAME*/ 07190000 * IF FSTSEC(1)='Z' THEN /* IF FIRST LETTER IN TRIPLE */ 07200000 CLI FSTSEC,C'Z' 0274 07210000 * GO TO CECTST18; /* LETTER SECTION NAME IS Z, */ 07220000 BC 08,CECTST18 0275 07230000 * /* SET ERROR CODE -07- AND */ 07240000 * /* PRINT ERROR MESSAGE IFD112I*/ 07250000 * R6=LET3PTR+1; /* NO, PERFORM NORMAL UPDATE */ 07260000 LA @6,1 0276 07270000 A @6,LET3PTR 0276 07280000 * FSTSEC(1)=LETTER; /* FOR FIRST LETTER OF TRIPLE */ 07290000 MVC FSTSEC(1),0(@6) 0277 07300000 * LET3PTR=R6; /* SECTION NAME */ 07310000 ST @6,LET3PTR 0278 07320000 * FSTSEC1='AA'; 07330000 MVC FSTSEC+1(2),@C25 0279 07340000 * LET1PTR=ADDR(ALPHABET); 07350000 LA @F,ALPHABET 0280 07360000 ST @F,LET1PTR 0280 07370000 * LET2PTR=LET1PTR; 07380000 MVC LET2PTR(4),LET1PTR 0281 07390000 * GO TO CECTST29; /* CONTINUE */ 07400000 BC 15,CECTST29 0282 07410000 * CECTST34: 07420000 * /************************************************************ 07430000 * /* * 07440000 * /* DECODE THE DELIMITERS * 07450000 * /* * 07460000 * /************************************************************ 07470000 * IF INPUTBUF(1)='/' THEN /* IS CHAR. IN INBUFR+0 A */ 07480000 CECTST34 CLI 0(@5),C'/' 0283 07490000 * GO TO CECTST35; /* SLASH. YES, CONTINUE TO */ 07500000 BC 08,CECTST35 0284 07510000 * IF INPUTBUF(1)^=',' THEN /* DECODE. NO, IS THE CHAR. */ 07520000 CLI 0(@5),C',' 0285 07530000 * GO TO CECTST56; /* IN INBUFR A COMMA. NO,SET*/ 07540000 BC 07,CECTST56 0286 07550000 * /* ERROR CODE -01- AND PRINT*/ 07560000 * /* ERROR MESSAGE IFD112I. */ 07570000 * R6=ADDR(NUMBERS); /* YES,SEE IF THE CHAR. IN */ 07580000 LA @6,NUMBERS 0287 07590000 * DO I=10 TO 1 BY -1; /* INBUFR+1 NUMERIC. YES, */ 07600000 LA @3,10 0288 07610000 * IF INPUTBUF(2)=NUMBER THEN /* STOP LOOKING FOR TEST */ 07620000 @DO9BE CLC 1(1,@5),0(@6) 0289 07630000 * GO TO CECTST35; /* SECTIONS. NO,CONTINUE TO */ 07640000 BC 08,CECTST35 0290 07650000 * R6=R6+1; /* DECODE */ 07660000 AH @6,@D1 0291 07670000 * END; 07680000 * R5=R5+1; 07690000 BCT @3,@DO9BE 0292 07700000 AH @5,@D1 0293 07710000 * GO TO CECTST14; 07720000 BC 15,CECTST14 0294 07730000 * CECTST35: 07740000 * NUMENTRY=SECCNTR; /* PUT SECTION COUNTER IN SECLST */ 07750000 CECTST35 STH @7,SECLIST 0295 07760000 * HRTSEL=0; /* CLEAR HIGHEST ROUTINE SELECTED.* 07770000 SR @F,@F 0296 07780000 STH @F,HRTSEL 0296 07790000 * IF INPUTBUF(1)='/' THEN /* IS CHAR. IN INBUFR+0 A SLASH */ 07800000 CLI 0(@5),C'/' 0297 07810000 * GO TO CECTST99; /* YES, RETURN TO IFDOLT30. NO, * 07820000 BC 08,CECTST99 0298 07830000 * /* CONTINUE DECODING * 07840000 * R5=R5+1; /* INCREMENT INBUFR COUNTER */ 07850000 AH @5,@D1 0299 07860000 * IF SECCNTR=1 THEN DO; /* CAN ROUTINES BE SPECIFIED S20203* 07870000 CH @7,@D1 0300 07880000 BC 07,@9BA 0300 07890000 * RTNFLD = '1'B; /* SET FLG TO DECODE ROUTINESS20203* 07900000 OI OLTEPSW1,B'10000000' 0302 07910000 * CECTST99:/* EXIT ROUTINE S20203* 07920000 * INBUFPTR=R5; /* SAVE INBUFR POINTER S20203* 07930000 CECTST99 ST @5,INBUFPTR 0303 07940000 * RETURN; /* RETURN TO CALLER S20203* 07950000 BC 15,@EL01 0304 07960000 * END; /* S20203* 07970000 * ERRCODE='08'; /* NO, SET ERROR CODE -08- & */ 07980000 @9BA MVC ERRCODE(2),@C27 0306 07990000 * GO TO CECTST03; /* PRINT ERROR MESSAGE IFD112I*/ 08000000 BC 15,CECTST03 0307 08010000 * CECTST56: 08020000 * /************************************************************ 08030000 * /* * 08040000 * /* ERROR, ILLEGAL DELIMITER * 08050000 * /* * 08060000 * /************************************************************ 08070000 * ERRCODE='01'; /* SET ERROR CODE -01- AND */ 08080000 CECTST56 MVC ERRCODE(2),@C28 0308 08090000 * GO TO CECTST03; /* PRINT ERROR MESSAGE IFD112I*/ 08100000 BC 15,CECTST03 0309 08110000 * CECTST05:/* ERROR, SECTION IS NOT ALPHABETIC */ 08120000 * ERRCODE='06'; /* SET ERROR CODE -06- AND PRINT */ 08130000 CECTST05 MVC ERRCODE(2),@C29 0310 08140000 * GO TO CECTST03; /* ERROR MESSAGE IFD112I */ 08150000 BC 15,CECTST03 0311 08160000 * CECTST06:/* FIND THE SLASH DELIMITER */ 08170000 * IF INPUTBUF(1)='/' THEN /* IS CHAR IN INBUFR+0 A SLASH.YES* 08180000 CECTST06 CLI 0(@5),C'/' 0312 08190000 BC 07,@9B9 0312 08200000 * DO; 08210000 * /********************************************************** 08220000 * /* * 08230000 * /* PWTO MESSAGE IFD155I * 08240000 * /* * 08250000 * /********************************************************** 08260000 * RESTRICT(1); 08270000 * R1=ADDR(IFDMSG32); /* GET POINTER TO MESSAGE MODULE * 08280000 L @4,@V1 ADDRESS OF IFDMSG32 0315 08290000 LR @1,@4 0315 08300000 * R1=MSGPTR55; /* GET POINTER TO MESSAGE IFD155I * 08310000 L @1,8(0,@1) 0316 08320000 * RELEASE(1); 08330000 * GEN(PWTO REG=(1)); /* PRINT MESSAGE. * 08340000 PWTO REG=(1) 08350000 DS 0H 08360000 * GO TO CECTST35; /* CONTINUE */ 08370000 BC 15,CECTST35 0319 08380000 * END; 08390000 * R5=R5+1; /* INCREMENT INBUFR POINTER */ 08400000 @9B9 AH @5,@D1 0321 08410000 * GO TO CECTST06; /* LOOP UNTIL SLASH FOUND */ 08420000 BC 15,CECTST06 0322 08430000 * END IFDOLT32; 08440000 @EL01 L @D,4(0,@D) 0323 08450000 LM @E,@C,12(@D) 0323 08460000 BCR 15,@E 0323 08470000 @DATA1 EQU * 08480000 @0 EQU 00 EQUATES FOR REGISTERS 0-15 08490000 @1 EQU 01 08500000 @2 EQU 02 08510000 @3 EQU 03 08520000 @4 EQU 04 08530000 @5 EQU 05 08540000 @6 EQU 06 08550000 @7 EQU 07 08560000 @8 EQU 08 08570000 @9 EQU 09 08580000 @A EQU 10 08590000 @B EQU 11 08600000 @C EQU 12 08610000 @D EQU 13 08620000 @E EQU 14 08630000 @F EQU 15 08640000 @D1 DC H'1' 08650000 @D2 DC H'4' 08660000 @D3 DC H'2' 08670000 @D4 DC H'3' 08680000 @D5 DC H'26' 08690000 @D6 DC H'5' 08700000 @V1 DC V(IFDMSG32) 08710000 DS 0F 08720000 @C3 DC C'04' 08730000 @C11 DC C'SOSPC/' 08740000 @C12 DC C'05' 08750000 @C19 DC C'07' 08760000 @C25 DC C'AA' 08770000 @C27 DC C'08' 08780000 @C28 DC C'01' 08790000 @C29 DC C'06' 08800000 @C14 DC C' A' 08810000 @C15 DC C' Z' 08820000 @C16 DC C' ' 08830000 @C23 DC C' AA' 08840000 @C24 DC C'AAA' 08850000 DS 0D 08860000 @DATA EQU * 08870000 @SAV001 EQU @DATA+00000000 72 BYTE(S) ON WORD 08880000 R1 EQU 00000001 FULLWORD POINTER REGISTER 08890000 R2 EQU 00000002 FULLWORD POINTER REGISTER 08900000 I EQU 00000003 3 BYTE POINTER REGISTER 08910000 RETCODE EQU 00000003 3 BYTE POINTER REGISTER 08920000 R5 EQU 00000005 FULLWORD POINTER REGISTER 08930000 R6 EQU 00000006 FULLWORD POINTER REGISTER 08940000 R7 EQU 00000007 FULLWORD POINTER REGISTER 08950000 SECCNTR EQU 00000007 3 BYTE POINTER REGISTER 08960000 R8 EQU 00000008 FULLWORD POINTER REGISTER 08970000 R13 EQU 00000013 FULLWORD POINTER REGISTER 08980000 R14 EQU 00000014 FULLWORD POINTER REGISTER 08990000 RC EQU 00000015 3 BYTE POINTER REGISTER 09000000 R15 EQU 00000015 FULLWORD POINTER REGISTER 09010000 MYSAVE EQU 00000000 8 BYTE(S) ON WORD 09020000 A00000 EQU MYSAVE+00000000 4 BYTE(S) 09030000 YOURR13 EQU MYSAVE+00000004 FULLWORD POINTER 09040000 YOURSAVE EQU 00000000 16 BYTE(S) ON WORD 09050000 A00001 EQU YOURSAVE+00000000 12 BYTE(S) 09060000 YOURR14 EQU YOURSAVE+00000012 FULLWORD POINTER 09070000 MSGPTR EQU 00000000 12 BYTE(S) ON WORD 09080000 MSGPTR12 EQU MSGPTR+00000000 FULLWORD POINTER 09090000 MSGPTR61 EQU MSGPTR+00000004 FULLWORD POINTER 09100000 MSGPTR55 EQU MSGPTR+00000008 FULLWORD POINTER 09110000 MSG112 EQU 00000000 41 BYTE(S) 09120000 A00006 EQU MSG112+00000000 4 BYTE(S) 09130000 MSG112I EQU MSG112+00000004 37 BYTE(S) 09140000 SECLSTXX EQU 00000000 5 BYTE(S) ON WORD 09150000 TSTSECTN EQU SECLSTXX+00000000 3 BYTE(S) 09160000 TSTSCTN3 EQU SECLSTXX+00000000 3 BYTE(S) 09170000 TSTSCTN2 EQU SECLSTXX+00000000 2 BYTE(S) 09180000 TSTSCTN1 EQU SECLSTXX+00000000 1 BYTE(S) 09190000 SECLNGTH EQU SECLSTXX+00000003 2 BYTE(S) 09200000 DOUBLEWD EQU @DATA+00000072 8 BYTE(S) ON DWORD 09210000 SAVR14 EQU DOUBLEWD+00000000 FULLWORD POINTER 09220000 LET1PTR EQU @DATA+00000080 FULLWORD POINTER 09230000 LET2PTR EQU @DATA+00000084 FULLWORD POINTER 09240000 LET3PTR EQU @DATA+00000088 FULLWORD POINTER 09250000 J EQU @DATA+00000092 HALFWORD INTEGER 09260000 ORG @DATA+00000094 09270000 ALPHABET EQU * 26 BYTE(S) 09280000 DC C'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 09290000 LETTER EQU 00000000 1 BYTE(S) 09300000 NUMBERS EQU * 10 BYTE(S) 09310000 DC C'0123456789' 09320000 NUMBER EQU 00000000 1 BYTE(S) 09330000 SWITCHES EQU * 1 BYTE(S) 09340000 DC X'00' 09350000 SECTIONS EQU SWITCHES+00000000 3 BIT(S) 09360000 SECT1 EQU SWITCHES+00000000 1 BIT(S) 09370000 SECT2 EQU SWITCHES+00000000 1 BIT(S) 09380000 SECT3 EQU SWITCHES+00000000 1 BIT(S) 09390000 EXPFLG EQU SWITCHES+00000000 1 BIT(S) 09400000 DUBNUM EQU SWITCHES+00000000 1 BIT(S) 09410000 TRINUM EQU SWITCHES+00000000 1 BIT(S) 09420000 FSTSEC EQU @DATA+00000131 3 BYTE(S) 09430000 A00007 EQU FSTSEC+00000000 1 BYTE(S) 09440000 FSTSEC1 EQU FSTSEC+00000001 2 BYTE(S) 09450000 FSTSECT1 EQU FSTSEC+00000001 1 BYTE(S) 09460000 FSTSEC2 EQU FSTSEC+00000002 1 BYTE(S) 09470000 LSTSEC EQU @DATA+00000134 3 BYTE(S) 09480000 A00008 EQU LSTSEC+00000000 1 BYTE(S) 09490000 LSTSEC1 EQU LSTSEC+00000001 2 BYTE(S) 09500000 A00009 EQU LSTSEC+00000001 1 BYTE(S) 09510000 LSTSEC2 EQU LSTSEC+00000002 1 BYTE(S) 09520000 ERRCODE EQU @DATA+00000137 2 BYTE(S) 09530000 INPUTBUF EQU 00000000 4 BYTE(S) 09540000 SOSPBUF EQU 00000000 6 BYTE(S) 09550000 RTNFIELD EQU 00000000 1 BYTE(S) 09560000 ORG @DATA 09570000 DS 00000139C 09580000 @TEMPS DS 0F 09590000 TESTCOMM IFDCOM 09600000 SCT EQU CHASCT+00000000 70 BYTE(S) ON WORD 09610000 A00002 EQU SCT+00000000 4 BYTE(S) 09620000 RTNFLDXX EQU SCT+00000004 2 BYTE(S) 09630000 A00003 EQU SCT+00000006 27 BYTE(S) 09640000 EXPGMFLG EQU SCT+00000033 1 BYTE(S) 09650000 A00004 EQU SCT+00000033 2 BIT(S) 09660000 RTNSLCTN EQU SCT+00000033 1 BIT(S) 09670000 A00005 EQU SCT+00000034 6 BYTE(S) 09680000 EXPANDED EQU SCT+00000040 30 BYTE(S) 09690000 SECLIST EQU SECLST+00000000 12 BYTE(S) ON WORD 09700000 NUMENTRY EQU SECLIST+00000000 HALFWORD INTEGER 09710000 PREFIXID EQU SECLIST+00000002 5 BYTE(S) 09720000 PREFIX EQU SECLIST+00000002 1 BYTE(S) 09730000 ID EQU SECLIST+00000003 4 BYTE(S) 09740000 SECLST7 EQU SECLIST+00000007 5 BYTE(S) 09750000 PGMTBL EQU PGMTAB+00000000 8 BYTE(S) 09760000 OLTEPSW EQU CESWT+00000000 1 BYTE(S) 09770000 LEGALTST EQU OLTEPSW+00000000 1 BIT(S) 09780000 A00010 EQU OLTEPSW+00000000 4 BIT(S) 09790000 REINT EQU OLTEPSW+00000000 1 BIT(S) 09800000 OLTEPSW1 EQU CESWT1+00000000 1 BYTE(S) 09810000 RTNFLD EQU OLTEPSW1+00000000 1 BIT(S) 09820000 @DATEND EQU * 09830000 END IFDOLT32,(C'PL/S',1400,78045) 09840000