*RECASE:
*   PROC OPTIONS(CODEREG(11,12));
*
*/********************************************************************/
*/*                                                                  */
*/* Reset case of rexx program to a 'standard' format.               */
*/*                                                                  */
*/********************************************************************/
*/*                                                                  */
*/*   1) Rexx keywords have the 1st letter capitalized               */
*/*   2) Variables and builtin functions are made lower case         */
*/*   3) Quoted strings and comments are unchanged                   */
*/*                                                                  */
*/*                                                                  */
*/*   Requires module RECASE                                         */
*/*                                                                  */
*/*   Parameters: None                                               */
*/*   author    : Doug nadel                                         */
*/*   date      : 09/25/85     - Initial code                        */
*/*             : 10/24/85     - Remove state var, fix CHANGES bug   */
*/*                                                                  */
*/********************************************************************/
*
*%ISREDIT:
*   MACRO;
*   DECLARE
*     STR      CHARACTER;
*   STR = MACLIST(2:LENGTH(MACLIST)-1);
*   ANS('CALL ISPLINK(''ISREDIT '',ZERO,'||STR||');') SKIP;
*   %END ISREDIT;
*   DECLARE
*     A        FIXED(31),           /* Counter                       */
*     bchrs    CHAR(*) BASED,       /* Based character string        */
*     INPTR    PTR(24),             /* Ptr to input data line        */
*     GO       CHAR(1),             /* ISPF dialog interface         */
*     ISPLINK  EXT ENTRY OPTIONS(VLIST), /* ISPF dialog interface    */
*     LAST     FIXED(31),           /* Line number of last line      */
*     LC       CHAR(1),             /* Type of string being scanned  */
*     LINEIN   CHAR(255),           /* Input line                    */
*     LINEMASK CHAR(LENGTH(LINEIN)), /* Mask to change line          */
*     LPTR     FIXED(31),           /* Line number of current line   */
*     LRECL    FIXED(31),           /* Lrecl of file                 */
*     LRECLC   CHAR(5),             /* Character form lf lrecl       */
*     OUTPTR   PTR(24),             /* Pointer to output line (Mask) */
*     TRTABLE1 CHAR(256) STATIC LOCAL BDY(DWORD) GEND,
*     TRTABLE2 CHAR(256) STATIC LOCAL BDY(DWORD) GEND,
*     TRTABLE3 CHAR(256) STATIC LOCAL BDY(DWORD) GEND,
*     ZERO     FIXED(31) CONSTANT(0),
*     ZEDSMSG  CHAR(22) INITIAL('INVALID EXEC'), /* Short message    */
*     1    ZEDLMSG  CHAR(80),       /* Long message                  */
*      2    *        CHAR(31) INITIAL('This exec is missing an ending '
*               ),
*      2    MISSING  CHAR(23) INITIAL('comment delimiter (*/).'),
*      2    *        CHAR(80-(23+31)) INITIAL(' '), /* Filler        */
*     1    GETLINE,                 /* Get line command              */
*      2    GETN1    CHAR(18),
*      2    GETNUM   CHAR(5),
*      2    GETN2    CHAR(2),
*     1    PUTLINE,                 /* Put line command              */
*      2    PUTN1    CHAR(7),
*      2    PUTNUM   CHAR(5),
*      2    PUTN2    CHAR(13);
*   GEN DATA DEFS (TRTABLE1,TRTABLE2,TRTABLE3);
*         DS 0D
*TRTABLE1 DC 256AL1(*-TRTABLE1)        UPCASE TO JUNK
*         ORG TRTABLE1+C'A'
*         DC  XL9'010203040506070809'
*         ORG TRTABLE1+C'J'
*         DC  XL9'0A0B0C0D0E0F101112'
*         ORG TRTABLE1+C'S'
*         DC  XL8'131415161718191A'
*         ORG TRTABLE1+C'a'
*         DC  XL9'1B1C1D1E1F20212223'
*         ORG TRTABLE1+C'j'
*         DC  XL9'2425262728292A2B2C'
*         ORG TRTABLE1+C's'
*         DC  XL8'2D2E2F3031323334'
*         ORG TRTABLE1+256
*TRTABLE2 DC 256AL1(*-TRTABLE2)       UPCASE TO LOWCASE
*         ORG TRTABLE2+C'A'
*         DC  CL9'abcdefghi'
*         ORG TRTABLE2+C'J'
*         DC  CL9'jklmnopqr'
*         ORG TRTABLE2+C'S'
*         DC  CL8'stuvwxyz'
*         ORG TRTABLE2+256
*TRTABLE3 DC 256AL1(*-TRTABLE3)       JUNK TO UPCASE
*         ORG TRTABLE3
*         DC XL1'00',CL26'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
*         DC CL26'abcdefghijklmnopqrstuvwxyz'
*         ORG TRTABLE3+256
*@ENDGEN
*
*   /*****************************************************************/
*   /*                                                               */
*   /* Declare constants                                             */
*   /*                                                               */
*   /*****************************************************************/
*
*   DECLARE
*     COMMENT  CHAR(1) CONSTANT('C'), /* In a comment                */
*     QUOTE1   CHAR(1) CONSTANT(''''), /* In a 'quoted string'       */
*     QUOTE2   CHAR(1) CONSTANT('"'), /* In a "Quoted string"        */
*     SCAN     CHAR(1) CONSTANT('S'); /* Not in comment or quote     */
*
*   /*****************************************************************/
*   /*                                                               */
*   /* Initialize ISPF and edit environment                          */
*   /*                                                               */
*   /*****************************************************************/
*
*   GETN1 = '¢ (LINEIN) = LINE ';   /* Initalize getline             */
*   GETN2 = ' ¢';
*   PUTN1 = '¢ LINE ';              /* Initialize putline            */
*   PUTN2 = ' = (LINEIN) ¢';
*   CALL ISPLINK('VDEFINE ','(GO)',GO,'CHAR',1); /* VDEFINES         */
*   CALL ISPLINK('VDEFINE ','(LAST)',LAST,'FIXED',4); /* VDEFINES    */
*   CALL ISPLINK('VDEFINE ','(LPTR)',LPTR,'FIXED',4);
*   CALL ISPLINK('VDEFINE ','(LRECLC)',LRECLC,'CHAR',LENGTH(LRECLC));
*   CALL ISPLINK('VDEFINE ','(LINEIN)',LINEIN,'CHAR',LENGTH(LINEIN));
*   CALL ISPLINK('VDEFINE ','(ZEDSMSG)',ZEDSMSG,'CHAR',22);
*   CALL ISPLINK('VDEFINE ','(ZEDLMSG)',ZEDLMSG,'CHAR',80);
*   ?ISREDIT('¢ MACRO (GO) ¢');     /* ISREDIT macro statement       */
*   IF (GO | ' ') ¬= 'G' THEN
*     CALL VERIFY;
*   ?ISREDIT('¢ (LAST) = LINENUM .ZLAST ¢'); /* Get last line        */
*   IF LAST = 0 THEN
*     GOTO EXIT;                    /* If file empty, skip recasing  */
*   ?ISREDIT('¢ CAPS OFF ¢');       /* Set caps off                  */
*   ?ISREDIT('¢ (STATE) = USER_STATE ¢'); /* Save state              */
*   ?ISREDIT('¢ (LRECLC) = LRECL ¢'); /* Get lrecl                   */
*   ?SPFCTF(LRECLC,LRECL);          /* Conver to character           */
*
*   /*****************************************************************/
*   /*                                                               */
*   /* Init ptrs and switches                                        */
*   /*                                                               */
*   /*****************************************************************/
*
*   LRECL = MIN(LRECL,LENGTH(LINEIN)); /* Lrecl must be less than 256*/
*
*   /*****************************************************************/
*   /*                                                               */
*   /* Loop through file                                             */
*   /*                                                               */
*   /*****************************************************************/
*
*   LPTR = 1;                       /* Point to 1st line in file     */
*   LC = SCAN;                      /* Set switch for lastchar       */
*   DO WHILE LAST >= LPTR;          /* Loop through lines            */
*     LINEIN = ''B;                 /* Zero line for input           */
*     ?SPFCTN(LPTR,GETNUM);         /* Put line number in command    */
*     ?ISREDIT(GETLINE);            /* Get line from file            */
*     LINEMASK = ''B;               /* Zero out mask                 */
*     INPTR = ADDR(LINEIN);         /* Point to buffer               */
*     OUTPTR = ADDR(LINEMASK);      /* Point to mask line            */
*     DO A = 1 TO LRECL;            /* Loop through line             */
*       SELECT;
*         WHEN(INPTR -> bchrs(1) = QUOTE1 & LC = SCAN)
*           LC = QUOTE1;            /* Turn scanning off             */
*         WHEN(INPTR -> bchrs(1) = QUOTE2 & LC = SCAN)
*           LC = QUOTE2;            /* Turn scanning off             */
*         WHEN(INPTR -> bchrs(1) = QUOTE1 & LC = QUOTE1)
*           LC = SCAN;              /* Turn scanning back on         */
*         WHEN(INPTR -> bchrs(1) = QUOTE2 & LC = QUOTE2)
*           LC = SCAN;              /* Turn scanning back on         */
*         WHEN(INPTR -> bchrs(1:2) = '/*' & LC = SCAN)
*           DO;
*             LC = COMMENT;         /* Lc indicates in comment       */
*             INPTR = INPTR + 1;    /* Bump pointer to buffer        */
*             OUTPTR = OUTPTR + 1;  /* Bump ptr to mask              */
*           END;
*         WHEN(INPTR -> bchrs(1:2) = '*/' & LC = COMMENT)
*           DO;
*             LC = SCAN;            /* Turn scanning on              */
*             INPTR = INPTR + 1;    /* Bump pointer to buffer        */
*             OUTPTR = OUTPTR + 1;  /* Bump ptr to mask              */
*           END;
*         OTHERWISE                 /* Ignore character              */
*           ;
*       END;
*       IF LC ¬= SCAN THEN          /* In a string or comment        */
*         DO;
*           OUTPTR -> bchrs(1) = INPTR -> bchrs(1); /* Move char to
*                                      mask                          */
*           INPTR -> bchrs(1) = '00'X; /* Remove character from line */
*         END;
*       INPTR = INPTR + 1;          /* Bump pointer to buffer        */
*       OUTPTR = OUTPTR + 1;        /* Bump ptr to mask              */
*     END;
*     TR(LINEMASK(1:LRECL),TRTABLE1); /* Translate mask to junk      */
*     LINEIN = LINEIN | LINEMASK;   /* Change ucase to junk in buffr */
*     PUTNUM = GETNUM;              /* Save line number in cmd string*/
*     ?ISREDIT(PUTLINE);            /* Put line back in file         */
*     LPTR = LPTR + 1;              /* Bump line counter             */
*   END;
*   IF LC ¬= SCAN THEN              /* If still in quote or comment  */
*     DO;                           /* Set up error message          */
*       SELECT(LC);
*         WHEN(QUOTE1)
*           MISSING = 'QUOTE ('')'; /* Single quote                  */
*         WHEN(QUOTE2)
*           MISSING = 'QUOTE (")';  /* Double quote                  */
*         OTHERWISE
*           ;                       /* Comment already set           */
*       END;
*       CALL ISPLINK('SETMSG','ISRZ001 '); /* Set the message        */
*     END;
*   LPTR = 1;                       /* Point to 1st line in file     */
*   IF LC = SCAN THEN               /* If not still in quote or
*                                      comment                       */
*     DO WHILE LAST >= LPTR;        /* Loop through lines            */
*       LINEIN = ''B;               /* Zero line for input           */
*       ?SPFCTN(LPTR,GETNUM);       /* Put line number in command    */
*       ?ISREDIT(GETLINE);          /* Get line from file            */
*       TR(LINEIN(1:LRECL),TRTABLE2); /* Translate whole line to
*                                      lcase                         */
*       PUTNUM = GETNUM;            /* Save line number in cmd string*/
*       ?ISREDIT(PUTLINE);          /* Put line back in file         */
*       LPTR = LPTR + 1;            /* Bump line counter             */
*     END;
*   IF LC = SCAN THEN               /* If not still in quote or
*                                      comment                       */
*     CALL CHANGES;                 /* Change 1st char of keywords to
*                                      upper case                    */
*   LPTR = 1;                       /* Point to 1st line in file     */
*   DO WHILE LAST >= LPTR;          /* Loop through lines            */
*     LINEIN = ''B;                 /* Zero line for input           */
*     ?SPFCTN(LPTR,GETNUM);         /* Put line number in command    */
*     ?ISREDIT(GETLINE);            /* Get line from file            */
*     TR(LINEIN(1:LRECL),TRTABLE3); /* Translate mask to ucase       */
*     PUTNUM = GETNUM;              /* Save line number in cmd string*/
*     ?ISREDIT(PUTLINE);            /* Put line back in file         */
*     LPTR = LPTR + 1;              /* Bump line counter             */
*   END;
*   ?ISREDIT('¢ USER_STATE = (STATE) ¢'); /* Restore user state      */
*EXIT:
*   CALL ISPLINK('VDELETE ','* ');  /* Delete variables              */
*   RETURN CODE(0);                 /* Return to edit                */
*@EJECT;
*CHANGES:                           /* Change keywords               */
*   PROC;
*   ?ISREDIT('¢ CAPS OFF ¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''if'' ''If''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''do'' ''Do''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''say'' ''Say''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''arg'' ''Arg''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''end'' ''End''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''nop'' ''Nop''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''var'' ''Var''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''call'' ''Call''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''drop'' ''Drop''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''else'' ''Else''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''exit'' ''Exit'' ¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''halt'' ''Halt'' ¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''pull'' ''Pull''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''push'' ''Push''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''then'' ''Then''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''when'' ''When''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''with'' ''With''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''error'' ''Error''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''leave'' ''Leave''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''parse'' ''Parse''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''queue'' ''Queue''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''trace'' ''Trace''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''upper'' ''Upper''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''until'' ''Until''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''value'' ''Value''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''while'' ''While''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''expose'' ''Expose''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''return'' ''Return''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''SELECT'' ''SELECT''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''signal'' ''Signal''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''source'' ''Source''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''syntax'' ''Syntax''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''address'' ''Address''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''iterate'' ''Iterate''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''novalue'' ''Novalue''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''numeric'' ''Numeric''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''version'' ''Version''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''external'' ''External''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''interpret'' ''Interpret''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''otherwise'' ''Otherwise''¢');
*   ?ISREDIT('¢ CHANGE ALL WORD ''procedure'' ''Procedure''¢');
*   ?ISREDIT('¢ UP MAX ¢');
*   END CHANGES;
*VERIFY:
*   PROC;
*   DCL
*     HEXCODE  FIXED(8),
*     RETCODE  REG(15) FIXED(31),
*     1    FINDXCMD,
*       3    *        CHAR(9) INITIAL('¢ FIND X'''),
*       3    OUTCODE  CHAR(2),
*       3    *        CHAR(9) INITIAL(''' FIRST ¢');
*   RFY
*     RETCODE RSTD;
*   DO HEXCODE = 1 TO 52 UNTIL RETCODE = 0;
*     ?SPFCTX(HEXCODE,OUTCODE);
*     ?ISREDIT(FINDXCMD);
*   END;
*   IF RETCODE = 0 THEN
*     DO;
*       ZEDSMSG = 'Invalid char(s)';
*       ZEDLMSG = 'Chars in the range ''01''X-''34''X found.  Use''RECA
*SE G'' to continue.';
*       CALL ISPLINK('SETMSG','ISRZ001 '); /* Set the message        */
*       ?ISREDIT('¢ HEX VERT ¢');
*       return TO EXIT;
*     END;
*   RFY
*     RETCODE;
*   END VERIFY;
*   END RECASE;
*---------------------------------------------------------------------*
*-------------------- Assembler code starts below --------------------*
*---------------------------------------------------------------------*
         TITLE ' RECASE:'
RECASE   CSECT ,
RECASE   AMODE 24
RECASE   RMODE 24
         STM   14,12,12(13)
         LR    11,15
         LA    12,4095(,11)
         USING RECASE,11
         USING RECASE+4095,12
         ST    13,SAVEAREA_1+4
         LA    14,SAVEAREA_1
         ST    14,8(,13)
         LR    13,14
*
*   /*****************************************************************/
*   /*                                                               */
*   /* Initialize ISPF and edit environment                          */
*   /*                                                               */
*   /*****************************************************************/
*
*   GETN1 = '¢ (LINEIN) = LINE ';   /* Initalize getline             */
         MVC   GETN1(18),=CL18'¢ (LINEIN) = LINE '
*   GETN2 = ' ¢';
         MVC   GETN2(2),=CL2' ¢'
*   PUTN1 = '¢ LINE ';              /* Initialize putline            */
         MVC   PUTN1(7),=CL7'¢ LINE '
*   PUTN2 = ' = (LINEIN) ¢';
         MVC   PUTN2(13),=CL13' = (LINEIN) ¢'
*   CALL ISPLINK('VDEFINE ','(GO)',GO,'CHAR',1); /* VDEFINES         */
         L     15,V_ISPLINK
         LA    1,ADDRLST1
         BALR  14,15
*   CALL ISPLINK('VDEFINE ','(LAST)',LAST,'FIXED',4); /* VDEFINES    */
         L     15,V_ISPLINK
         LA    1,ADDRLST2
         BALR  14,15
*   CALL ISPLINK('VDEFINE ','(LPTR)',LPTR,'FIXED',4);
         L     15,V_ISPLINK
         LA    1,ADDRLST3
         BALR  14,15
*   CALL ISPLINK('VDEFINE ','(LRECLC)',LRECLC,'CHAR',LENGTH(LRECLC));
         L     15,V_ISPLINK
         LA    1,ADDRLST4
         BALR  14,15
*   CALL ISPLINK('VDEFINE ','(LINEIN)',LINEIN,'CHAR',LENGTH(LINEIN));
         L     15,V_ISPLINK
         LA    1,ADDRLST5
         BALR  14,15
*   CALL ISPLINK('VDEFINE ','(ZEDSMSG)',ZEDSMSG,'CHAR',22);
         L     15,V_ISPLINK
         LA    1,ADDRLST6
         BALR  14,15
*   CALL ISPLINK('VDEFINE ','(ZEDLMSG)',ZEDLMSG,'CHAR',80);
         L     15,V_ISPLINK
         LA    1,ADDRLST7
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,'¢ MACRO (GO) ¢'); /* ISREDIT macro
*                                      statement                     */
         L     15,V_ISPLINK
         LA    1,ADDRLST8
         BALR  14,15
*   IF (GO | ' ') ¬= 'G' THEN
         MVC   TEMPSTRING1(1),GO
         OI    TEMPSTRING1,C' '
         CLI   TEMPSTRING1,C'G'
         BE    LABEL_1
*     CALL VERIFY;
         BAL   14,VERIFY
*   CALL ISPLINK('ISREDIT ',ZERO,'¢ (LAST) = LINENUM .ZLAST ¢'); /*
*                                      Get last line                 */
LABEL_1  L     15,V_ISPLINK
         LA    1,ADDRLST9
         BALR  14,15
*   IF LAST = 0 THEN
         ICM   10,15,LAST
         BZ    EXIT
*     GOTO EXIT;                    /* If file empty, skip recasing  */
*   CALL ISPLINK('ISREDIT ',ZERO,'¢ CAPS OFF ¢'); /* Set caps off    */
         L     15,V_ISPLINK
         LA    1,ADDRLST20
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,'¢ (STATE) = USER_STATE ¢'); /* Save
*                                      state                         */
         L     15,V_ISPLINK
         LA    1,ADDRLST10
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,'¢ (LRECLC) = LRECL ¢'); /* Get
*                                      lrecl                         */
*
         L     15,V_ISPLINK
         LA    1,ADDRLST11
         BALR  14,15
*   /*****************************************************************/
*   /*                                                               */
*   /* ?SPFCTF (LRECLC,LRECL,)                                       */
*   /*                                                               */
*   /*****************************************************************/
*
*   DO;
*     DECLARE
*       SPFCTFI  FIXED(15),
*       SPFCTFW1 CHAR(8) BOUNDARY(DWORD),
*       SPFCTFW2 CHAR(8) BOUNDARY(DWORD);
*     DO SPFCTFI = LENGTH(LRECLC) TO 1 BY - 1 WHILE(LRECLC(SPFCTFI)=' '
*           );
         LA    2,5
         LA    3,LRECLC-1(2)
         CLI   0(3),C' '
         BNE   LABEL_3
LABEL_2  DS    0H
*     END;
         BCTR  2,0
         LTR   2,2
         BNP   LABEL_3
         LA    10,LRECLC-1(2)
         CLI   0(10),C' '
         BE    LABEL_2
LABEL_3  DS    0H
*     SPFCTFW1 = '00000000';
         MVC   SPFCTFW1(8),=CL8'00000000'
*     SPFCTFW1(9-SPFCTFI:8) = LRECLC(1:SPFCTFI);
         LA    3,9
         SLR   3,2
         LA    6,SPFCTFW1-1(3)
         MVI   TEMPSTRING1+1,C' '
         MVC   TEMPSTRING1+2(6),TEMPSTRING1+1
         LR    10,2
         BCTR  10,0
         EX    10,INSTRUCTION1 -> MVC TEMPSTRING1(0),LRECLC
         LCR   3,3
         LA    10,8
         ALR   3,10
         EX    3,INSTRUCTION2 -> MVC 0(0,6),TEMPSTRING1
*     PACK(SPFCTFW2,SPFCTFW1);
         PACK  SPFCTFW2(8),SPFCTFW1(8)
*     CVB(LRECL,SPFCTFW2);
         CVB   5,SPFCTFW2
*   END;
*
*   /*****************************************************************/
*   /*                                                               */
*   /* Init ptrs and switches                                        */
*   /*                                                               */
*   /*****************************************************************/
*
*   LRECL = MIN(LRECL,LENGTH(LINEIN)); /* Lrecl must be less than 256*/
*
         LA    6,255
         CR    5,6
         BNH   LABEL_4
         LR    5,6
LABEL_4  DS    0H
*   /*****************************************************************/
*   /*                                                               */
*   /* Loop through file                                             */
*   /*                                                               */
*   /*****************************************************************/
*
*   LPTR = 1;                       /* Point to 1st line in file     */
         LA    4,1
         ST    4,LPTR
*   LC = SCAN;                      /* Set switch for lastchar       */
         MVI   LC,C'S'
*   DO WHILE LAST >= LPTR;          /* Loop through lines            */
         L     2,LPTR
         C     2,LAST
         BH    LABEL_21
         LA    9,LINEIN
         LA    8,LINEMASK
         LR    7,5
         BCTR  7,0
LABEL_5  DS    0H
*     LINEIN = ''B;                 /* Zero line for input           */
*
         XC    LINEIN(255),LINEIN
*     /***************************************************************/
*     /*                                                             */
*     /* ?SPFCTN (LPTR,GETNUM)                                       */
*     /*                                                             */
*     /***************************************************************/
*
*     DO;
*       DECLARE
*         SPFCTNW  CHAR(8) BOUNDARY(DWORD),
*         SPFCTNX  CHAR(16);
*       CVD(LPTR,SPFCTNW);
         CVD   2,SPFCTNW
*       UNPK(SPFCTNX,SPFCTNW);
         UNPK  SPFCTNX(16),SPFCTNW(8)
*       GENERATE( OI SPFCTNX+15,X'F0');
          OI SPFCTNX+15,X'F0'
*       GETNUM = SPFCTNX(17-LENGTH(GETNUM):16);
         MVC   GETNUM(5),SPFCTNX+11
*     END;
*     CALL ISPLINK('ISREDIT ',ZERO,GETLINE); /* Get line from file   */
         L     15,V_ISPLINK
         LA    1,ADDRLST12
         BALR  14,15
*     LINEMASK = ''B;               /* Zero out mask                 */
         XC    LINEMASK(255),LINEMASK
*     INPTR = ADDR(LINEIN);         /* Point to buffer               */
         LR    2,9
*     OUTPTR = ADDR(LINEMASK);      /* Point to mask line            */
         LR    3,8
*     DO A = 1 TO LRECL;            /* Loop through line             */
         LR    6,4
         CR    6,5
         BH    LABEL_20
LABEL_6  DS    0H
*       SELECT;
         CLI   0(2),C''''
         BNE   LABEL_7
         CLI   LC,C'S'
         BE    LABEL_12
LABEL_7  CLI   0(2),C'"'
         BNE   LABEL_8
         CLI   LC,C'S'
         BE    LABEL_13
LABEL_8  CLI   0(2),C''''
         BNE   LABEL_9
         CLI   LC,C''''
         BE    LABEL_14
LABEL_9  CLI   0(2),C'"'
         BNE   LABEL_10
         CLI   LC,C'"'
         BE    LABEL_15
LABEL_10 CLC   0(2,2),=CL2'/*'
         BNE   LABEL_11
         CLI   LC,C'S'
         BE    LABEL_16
LABEL_11 CLC   0(2,2),=CL2'*/'
         BNE   LABEL_18
         CLI   LC,C'C'
         BNE   LABEL_18
         B     LABEL_17
*         WHEN(INPTR -> bchrs(1) = QUOTE1 & LC = SCAN)
LABEL_12 DS    0H
*           LC = QUOTE1;            /* Turn scanning off             */
         MVI   LC,C''''
*         WHEN(INPTR -> bchrs(1) = QUOTE2 & LC = SCAN)
         B     LABEL_18
LABEL_13 DS    0H
*           LC = QUOTE2;            /* Turn scanning off             */
         MVI   LC,C'"'
*         WHEN(INPTR -> bchrs(1) = QUOTE1 & LC = QUOTE1)
         B     LABEL_18
LABEL_14 DS    0H
*           LC = SCAN;              /* Turn scanning back on         */
         MVI   LC,C'S'
*         WHEN(INPTR -> bchrs(1) = QUOTE2 & LC = QUOTE2)
         B     LABEL_18
LABEL_15 DS    0H
*           LC = SCAN;              /* Turn scanning back on         */
         MVI   LC,C'S'
*         WHEN(INPTR -> bchrs(1:2) = '/*' & LC = SCAN)
         B     LABEL_18
LABEL_16 DS    0H
*           DO;
*             LC = COMMENT;         /* Lc indicates in comment       */
         MVI   LC,C'C'
*             INPTR = INPTR + 1;    /* Bump pointer to buffer        */
         ALR   2,4
*             OUTPTR = OUTPTR + 1;  /* Bump ptr to mask              */
         ALR   3,4
*           END;
*         WHEN(INPTR -> bchrs(1:2) = '*/' & LC = COMMENT)
         B     LABEL_18
LABEL_17 DS    0H
*           DO;
*             LC = SCAN;            /* Turn scanning on              */
         MVI   LC,C'S'
*             INPTR = INPTR + 1;    /* Bump pointer to buffer        */
         ALR   2,4
*             OUTPTR = OUTPTR + 1;  /* Bump ptr to mask              */
         ALR   3,4
*           END;
*         OTHERWISE                 /* Ignore character              */
LABEL_18 DS    0H
*           ;
*       END;
*       IF LC ¬= SCAN THEN          /* In a string or comment        */
         CLI   LC,C'S'
         BE    LABEL_19
*         DO;
*           OUTPTR -> bchrs(1) = INPTR -> bchrs(1); /* Move char to
*                                      mask                          */
         MVC   0(1,3),0(2)
*           INPTR -> bchrs(1) = '00'X; /* Remove character from line */
         MVI   0(2),X'00'
*         END;
*       INPTR = INPTR + 1;          /* Bump pointer to buffer        */
LABEL_19 ALR   2,4
*       OUTPTR = OUTPTR + 1;        /* Bump ptr to mask              */
         ALR   3,4
*     END;
         ALR   6,4
         CR    6,5
         BNH   LABEL_6
LABEL_20 DS    0H
*     TR(LINEMASK(1:LRECL),TRTABLE1); /* Translate mask to junk      */
         EX    7,INSTRUCTION3 -> TR LINEMASK(0),TRTABLE1
*     LINEIN = LINEIN | LINEMASK;   /* Change ucase to junk in buffr */
         OC    LINEIN(255),LINEMASK
*     PUTNUM = GETNUM;              /* Save line number in cmd string*/
         MVC   PUTNUM(5),GETNUM
*     CALL ISPLINK('ISREDIT ',ZERO,PUTLINE); /* Put line back in file*/
         L     15,V_ISPLINK
         LA    1,ADDRLST15
         BALR  14,15
*     LPTR = LPTR + 1;              /* Bump line counter             */
         LR    3,4
         AL    3,LPTR
         ST    3,LPTR
*   END;
         LR    2,3
         C     2,LAST
         BNH   LABEL_5
LABEL_21 DS    0H
*   IF LC ¬= SCAN THEN              /* If still in quote or comment  */
         CLI   LC,C'S'
         BE    LABEL_25
*     DO;                           /* Set up error message          */
*       SELECT(LC);
         CLI   LC,C''''
         BE    LABEL_22
         CLI   LC,C'"'
         BNE   LABEL_24
         B     LABEL_23
*         WHEN(QUOTE1)
LABEL_22 DS    0H
*           MISSING = 'QUOTE ('')'; /* Single quote                  */
         MVI   MISSING+9,C' '
         MVC   MISSING+10(13),MISSING+9
         MVC   MISSING(9),=CL9'QUOTE ('')'
*         WHEN(QUOTE2)
         B     LABEL_24
LABEL_23 DS    0H
*           MISSING = 'QUOTE (")';  /* Double quote                  */
         MVI   MISSING+9,C' '
         MVC   MISSING+10(13),MISSING+9
         MVC   MISSING(9),=CL9'QUOTE (")'
*         OTHERWISE
LABEL_24 DS    0H
*           ;                       /* Comment already set           */
*       END;
*       CALL ISPLINK('SETMSG','ISRZ001 '); /* Set the message        */
         L     15,V_ISPLINK
         LA    1,ADDRLST65
         BALR  14,15
*     END;
*   LPTR = 1;                       /* Point to 1st line in file     */
LABEL_25 ST    4,LPTR
*   IF LC = SCAN THEN               /* If not still in quote or
*                                      comment                       */
         CLI   LC,C'S'
         BNE   LABEL_27
*     DO WHILE LAST >= LPTR;        /* Loop through lines            */
         LR    3,4
         C     3,LAST
         BH    LABEL_27
         LR    2,5
         BCTR  2,0
LABEL_26 DS    0H
*       LINEIN = ''B;               /* Zero line for input           */
*
         XC    LINEIN(255),LINEIN
*       /*************************************************************/
*       /*                                                           */
*       /* ?SPFCTN (LPTR,GETNUM)                                     */
*       /*                                                           */
*       /*************************************************************/
*
*       DO;
*         CVD(LPTR,SPFCTNW);
         CVD   3,SPFCTNW
*         UNPK(SPFCTNX,SPFCTNW);
         UNPK  SPFCTNX(16),SPFCTNW(8)
*         GENERATE( OI SPFCTNX+15,X'F0');
          OI SPFCTNX+15,X'F0'
*         GETNUM = SPFCTNX(17-LENGTH(GETNUM):16);
         MVC   GETNUM(5),SPFCTNX+11
*       END;
*       CALL ISPLINK('ISREDIT ',ZERO,GETLINE); /* Get line from file */
         L     15,V_ISPLINK
         LA    1,ADDRLST13
         BALR  14,15
*       TR(LINEIN(1:LRECL),TRTABLE2); /* Translate whole line to
*                                      lcase                         */
         EX    2,INSTRUCTION4 -> TR LINEIN(0),TRTABLE2
*       PUTNUM = GETNUM;            /* Save line number in cmd string*/
         MVC   PUTNUM(5),GETNUM
*       CALL ISPLINK('ISREDIT ',ZERO,PUTLINE); /* Put line back in
*                                      file                          */
         L     15,V_ISPLINK
         LA    1,ADDRLST16
         BALR  14,15
*       LPTR = LPTR + 1;            /* Bump line counter             */
         LR    10,4
         AL    10,LPTR
         ST    10,LPTR
*     END;
         LR    3,10
         C     3,LAST
         BNH   LABEL_26
LABEL_27 DS    0H
*   IF LC = SCAN THEN               /* If not still in quote or
*                                      comment                       */
         CLI   LC,C'S'
         BNE   LABEL_28
*     CALL CHANGES;                 /* Change 1st char of keywords to
*                                      upper case                    */
         BAL   14,CHANGES
*   LPTR = 1;                       /* Point to 1st line in file     */
LABEL_28 ST    4,LPTR
*   DO WHILE LAST >= LPTR;          /* Loop through lines            */
         LR    3,4
         C     3,LAST
         BH    LABEL_30
         LR    2,5
         BCTR  2,0
LABEL_29 DS    0H
*     LINEIN = ''B;                 /* Zero line for input           */
*
         XC    LINEIN(255),LINEIN
*     /***************************************************************/
*     /*                                                             */
*     /* ?SPFCTN (LPTR,GETNUM)                                       */
*     /*                                                             */
*     /***************************************************************/
*
*     DO;
*       CVD(LPTR,SPFCTNW);
         CVD   3,SPFCTNW
*       UNPK(SPFCTNX,SPFCTNW);
         UNPK  SPFCTNX(16),SPFCTNW(8)
*       GENERATE( OI SPFCTNX+15,X'F0');
          OI SPFCTNX+15,X'F0'
*       GETNUM = SPFCTNX(17-LENGTH(GETNUM):16);
         MVC   GETNUM(5),SPFCTNX+11
*     END;
*     CALL ISPLINK('ISREDIT ',ZERO,GETLINE); /* Get line from file   */
         L     15,V_ISPLINK
         LA    1,ADDRLST14
         BALR  14,15
*     TR(LINEIN(1:LRECL),TRTABLE3); /* Translate mask to ucase       */
         EX    2,INSTRUCTION5 -> TR LINEIN(0),TRTABLE3
*     PUTNUM = GETNUM;              /* Save line number in cmd string*/
         MVC   PUTNUM(5),GETNUM
*     CALL ISPLINK('ISREDIT ',ZERO,PUTLINE); /* Put line back in file*/
         L     15,V_ISPLINK
         LA    1,ADDRLST17
         BALR  14,15
*     LPTR = LPTR + 1;              /* Bump line counter             */
         LR    10,4
         AL    10,LPTR
         ST    10,LPTR
*   END;
         LR    3,10
         C     3,LAST
         BNH   LABEL_29
LABEL_30 DS    0H
*   CALL ISPLINK('ISREDIT ',ZERO,'¢ USER_STATE = (STATE) ¢'); /*
*                                      Restore user state            */
         L     15,V_ISPLINK
         LA    1,ADDRLST18
         BALR  14,15
*   EXIT:CALL ISPLINK('VDELETE ','* '); /* Delete variables          */
EXIT     L     15,V_ISPLINK
         LA    1,ADDRLST19
         BALR  14,15
*   RETURN CODE(0);                 /* Return to edit                */
         SLR   15,15
         L     13,4(,13)
         L     14,12(,13)
         LM    0,12,20(13)
         BR    14
*   END RECASE;
INSTRUCTION1 MVC TEMPSTRING1(0),LRECLC
INSTRUCTION2 MVC 0(0,6),TEMPSTRING1
INSTRUCTION3 TR LINEMASK(0),TRTABLE1
INSTRUCTION4 TR LINEIN(0),TRTABLE2
INSTRUCTION5 TR LINEIN(0),TRTABLE3
*CHANGES:                           /* Change keywords               */
*   PROCEDURE;
CHANGES  STM   14,12,SAVEAREA_3
*   CALL ISPLINK('ISREDIT ',ZERO,'¢ CAPS OFF ¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST21
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,'¢ CHANGE ALL WORD ''if'' ''If''¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST22
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,'¢ CHANGE ALL WORD ''do'' ''Do''¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST23
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,'¢ CHANGE ALL WORD ''say'' ''Say''¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST24
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,'¢ CHANGE ALL WORD ''arg'' ''Arg''¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST25
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,'¢ CHANGE ALL WORD ''end'' ''End''¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST26
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,'¢ CHANGE ALL WORD ''nop'' ''Nop''¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST27
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,'¢ CHANGE ALL WORD ''var'' ''Var''¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST28
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,'¢ CHANGE ALL WORD ''call'' ''Call''¢'
*       );
         L     15,V_ISPLINK
         LA    1,ADDRLST29
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,'¢ CHANGE ALL WORD ''drop'' ''Drop''¢'
*       );
         L     15,V_ISPLINK
         LA    1,ADDRLST30
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,'¢ CHANGE ALL WORD ''else'' ''Else''¢'
*       );
         L     15,V_ISPLINK
         LA    1,ADDRLST31
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,'¢ CHANGE ALL WORD ''exit'' ''Exit'' ¢
*       );
         L     15,V_ISPLINK
         LA    1,ADDRLST32
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,'¢ CHANGE ALL WORD ''halt'' ''Halt'' ¢
*       );
         L     15,V_ISPLINK
         LA    1,ADDRLST33
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,'¢ CHANGE ALL WORD ''pull'' ''Pull''¢'
*       );
         L     15,V_ISPLINK
         LA    1,ADDRLST34
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,'¢ CHANGE ALL WORD ''push'' ''Push''¢'
*       );
         L     15,V_ISPLINK
         LA    1,ADDRLST35
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,'¢ CHANGE ALL WORD ''then'' ''Then''¢'
*       );
         L     15,V_ISPLINK
         LA    1,ADDRLST36
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,'¢ CHANGE ALL WORD ''when'' ''When''¢'
*       );
         L     15,V_ISPLINK
         LA    1,ADDRLST37
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,'¢ CHANGE ALL WORD ''with'' ''With''¢'
*       );
         L     15,V_ISPLINK
         LA    1,ADDRLST38
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,
*       '¢ CHANGE ALL WORD ''error'' ''Error''¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST39
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,
*       '¢ CHANGE ALL WORD ''leave'' ''Leave''¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST40
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,
*       '¢ CHANGE ALL WORD ''parse'' ''Parse''¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST41
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,
*       '¢ CHANGE ALL WORD ''queue'' ''Queue''¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST42
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,
*       '¢ CHANGE ALL WORD ''trace'' ''Trace''¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST43
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,
*       '¢ CHANGE ALL WORD ''upper'' ''Upper''¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST44
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,
*       '¢ CHANGE ALL WORD ''until'' ''Until''¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST45
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,
*       '¢ CHANGE ALL WORD ''value'' ''Value''¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST46
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,
*       '¢ CHANGE ALL WORD ''while'' ''While''¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST47
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,
*       '¢ CHANGE ALL WORD ''expose'' ''Expose''¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST48
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,
*       '¢ CHANGE ALL WORD ''return'' ''Return''¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST49
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,
*       '¢ CHANGE ALL WORD ''SELECT'' ''SELECT''¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST50
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,
*       '¢ CHANGE ALL WORD ''signal'' ''Signal''¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST51
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,
*       '¢ CHANGE ALL WORD ''source'' ''Source''¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST52
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,
*       '¢ CHANGE ALL WORD ''syntax'' ''Syntax''¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST53
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,
*       '¢ CHANGE ALL WORD ''address'' ''Address''¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST54
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,
*       '¢ CHANGE ALL WORD ''iterate'' ''Iterate''¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST55
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,
*       '¢ CHANGE ALL WORD ''novalue'' ''Novalue''¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST56
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,
*       '¢ CHANGE ALL WORD ''numeric'' ''Numeric''¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST57
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,
*       '¢ CHANGE ALL WORD ''version'' ''Version''¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST58
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,
*       '¢ CHANGE ALL WORD ''external'' ''External''¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST59
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,
*       '¢ CHANGE ALL WORD ''interpret'' ''Interpret''¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST60
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,
*       '¢ CHANGE ALL WORD ''otherwise'' ''Otherwise''¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST61
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,
*       '¢ CHANGE ALL WORD ''procedure'' ''Procedure''¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST62
         BALR  14,15
*   CALL ISPLINK('ISREDIT ',ZERO,'¢ UP MAX ¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST63
         BALR  14,15
*   END CHANGES;
LABEL_31 LM    14,12,SAVEAREA_3
         BR    14
*VERIFY:
*   PROCEDURE;
VERIFY   STM   14,12,SAVEAREA_2
*   DO HEXCODE = 1 TO 52 UNTIL RETCODE = 0;
*
         LA    5,1
         LR    4,5
         LA    6,2
LABEL_32 DS    0H
*     /***************************************************************/
*     /*                                                             */
*     /* ?SPFCTX (HEXCODE,OUTCODE)                                   */
*     /*                                                             */
*     /***************************************************************/
*
*     DO;
*       DECLARE
*         1    SPFCTXI,
*          2    SPFCTXID CHAR(4),
*          2    *        CHAR(1),
*         1    SPFCTXO,
*          2    SPFCTXOD CHAR(8),
*          2    *        CHAR(1),
*         SPFCTXT  CHAR(16) INIT('0123456789ABCDEF'),
*         SPFCTXX  FIXED(15);
*       SPFCTXID(5-LENGTH(HEXCODE):4) = HEXCODE;
         STC   4,SPFCTXID+3
*       UNPK(SPFCTXO,SPFCTXI);
         UNPK  SPFCTXO(9),SPFCTXI(5)
*       DO SPFCTXX = 1 TO LENGTH(OUTCODE) BY 1;
         LR    3,5
LABEL_33 DS    0H
*         OUTCODE(SPFCTXX) = SPFCTXT(SPFCTXOD(8+SPFCTXX-LENGTH(OUTCODE)
*             )-239);
         LA    7,OUTCODE-1(3)
         SLR   10,10
         IC    10,SPFCTXOD+5(3)
         LA    14,SPFCTXT-240(10)
         MVC   0(1,7),0(14)
*       END;
         ALR   3,5
         CR    3,6
         BNH   LABEL_33
*     END;
*     CALL ISPLINK('ISREDIT ',ZERO,FINDXCMD);
         L     15,V_ISPLINK
         LA    1,ADDRLST64
         BALR  14,15
*   END;
         LTR   15,15
         BZ    LABEL_34
         ALR   4,5
         LA    10,52
         CR    4,10
         BNH   LABEL_32
LABEL_34 DS    0H
*   IF RETCODE = 0 THEN
         LTR   15,15
         BNZ   LABEL_35
*     DO;
*       ZEDSMSG = 'Invalid char(s)';
         MVC   ZEDSMSG(22),=CL22'Invalid char(s)'
*       ZEDLMSG = 'Chars in the range ''01''X-''34''X found.  Use ''REC
*SE G'' to continue.';
         MVI   ZEDLMSG+66,C' '
         MVC   ZEDLMSG+67(13),ZEDLMSG+66
         MVC   ZEDLMSG(66),CHARCONST_1
*       CALL ISPLINK('SETMSG','ISRZ001 '); /* Set the message        */
         L     15,V_ISPLINK
         LA    1,ADDRLST66
         BALR  14,15
*       CALL ISPLINK('ISREDIT ',ZERO,'¢ HEX VERT ¢');
         L     15,V_ISPLINK
         LA    1,ADDRLST67
         BALR  14,15
*       RETURN TO EXIT;
         LA    14,EXIT
         BR    14
*     END;
*   RESPECIFY
*     RETCODE;
LABEL_35 DS    0H
*   END VERIFY;
LABEL_36 LM    14,12,SAVEAREA_2
         BR    14
ADDRLST1 DC    A(CL8_VDEFINE,CL4__GO_,GO,CL4_CHAR,X'80000000'+FIXED_1)
ADDRLST2 DC    A(CL8_VDEFINE,CL6__LAST_,LAST,CL5_FIXED)
         DC    A(X'80000000'+FIXED_4)
ADDRLST3 DC    A(CL8_VDEFINE,CL6__LPTR_,LPTR,CL5_FIXED)
         DC    A(X'80000000'+FIXED_4)
ADDRLST4 DC    A(CL8_VDEFINE,CL8__LRECLC_,LRECLC,CL4_CHAR)
         DC    A(X'80000000'+FIXED_5)
ADDRLST5 DC    A(CL8_VDEFINE,CL8__LINEIN_,LINEIN,CL4_CHAR)
         DC    A(X'80000000'+FIXED_255)
ADDRLST6 DC    A(CL8_VDEFINE,CL9__ZEDSMSG_,ZEDSMSG,CL4_CHAR)
         DC    A(X'80000000'+FIXED_22)
ADDRLST7 DC    A(CL8_VDEFINE,CL9__ZEDLMSG_,ZEDLMSG,CL4_CHAR)
         DC    A(X'80000000'+FIXED_80)
ADDRLST8 DC    A(CL8_ISREDIT,FIXED_0,X'80000000'+CL14___MACRO__GO___)
ADDRLST9 DC    A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_43)
ADDRLST10 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_44)
ADDRLST11 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_46)
ADDRLST12 DS   0A
ADDRLST13 DS   0A
ADDRLST14 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+GETLINE)
ADDRLST15 DS   0A
ADDRLST16 DS   0A
ADDRLST17 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+PUTLINE)
ADDRLST18 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_45)
ADDRLST19 DC   A(CL8_VDELETE,X'80000000'+CL2__)
ADDRLST20 DS   0A
ADDRLST21 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CL12___CAPS_OFF__)
ADDRLST22 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_41)
ADDRLST23 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_42)
ADDRLST24 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_36)
ADDRLST25 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_37)
ADDRLST26 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_38)
ADDRLST27 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_39)
ADDRLST28 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_40)
ADDRLST29 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_28)
ADDRLST30 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_29)
ADDRLST31 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_30)
ADDRLST32 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_26)
ADDRLST33 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_27)
ADDRLST34 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_31)
ADDRLST35 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_32)
ADDRLST36 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_33)
ADDRLST37 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_34)
ADDRLST38 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_35)
ADDRLST39 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_17)
ADDRLST40 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_18)
ADDRLST41 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_19)
ADDRLST42 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_20)
ADDRLST43 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_21)
ADDRLST44 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_22)
ADDRLST45 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_23)
ADDRLST46 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_24)
ADDRLST47 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_25)
ADDRLST48 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_11)
ADDRLST49 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_12)
ADDRLST50 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_13)
ADDRLST51 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_14)
ADDRLST52 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_15)
ADDRLST53 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_16)
ADDRLST54 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_6)
ADDRLST55 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_7)
ADDRLST56 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_8)
ADDRLST57 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_9)
ADDRLST58 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_10)
ADDRLST59 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_5)
ADDRLST60 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_2)
ADDRLST61 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_3)
ADDRLST62 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CHARCONST_4)
ADDRLST63 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CL10___UP_MAX__)
ADDRLST64 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+FINDXCMD)
ADDRLST65 DS   0A
ADDRLST66 DC   A(CL6_SETMSG,X'80000000'+CL8_ISRZ001)
ADDRLST67 DC   A(CL8_ISREDIT,FIXED_0,X'80000000'+CL12___HEX_VERT__)
SAVEAREA_1 DS  18F
         DS    15F
         ORG   *-60
SAVEAREA_2 DS  015F
SAVEAREA_3 DS  15F
         ORG   ,
FIXED_0  DC    F'0'
FIXED_1  DC    F'1'
FIXED_4  DC    F'4'
FIXED_5  DC    F'5'
FIXED_22 DC    F'22'
FIXED_80 DC    F'80'
FIXED_255 DC   F'255'
V_ISPLINK DC   V(ISPLINK)
         LTORG
LAST     DS    F
LPTR     DS    F
TEMPSTRING1 DS CL8
CHARCONST_1 DC CL66'Chars in the range ''01''X-''34''X found.  Use ''RE*
               CASE G'' to continue.'
CHARCONST_2 DC CL42'¢ CHANGE ALL WORD ''interpret'' ''Interpret''¢'
CHARCONST_3 DC CL42'¢ CHANGE ALL WORD ''otherwise'' ''Otherwise''¢'
CHARCONST_4 DC CL42'¢ CHANGE ALL WORD ''procedure'' ''Procedure''¢'
CHARCONST_5 DC CL40'¢ CHANGE ALL WORD ''external'' ''External''¢'
CHARCONST_6 DC CL38'¢ CHANGE ALL WORD ''address'' ''Address''¢'
CHARCONST_7 DC CL38'¢ CHANGE ALL WORD ''iterate'' ''Iterate''¢'
CHARCONST_8 DC CL38'¢ CHANGE ALL WORD ''novalue'' ''Novalue''¢'
CHARCONST_9 DC CL38'¢ CHANGE ALL WORD ''numeric'' ''Numeric''¢'
CHARCONST_10 DC CL38'¢ CHANGE ALL WORD ''version'' ''Version''¢'
CHARCONST_11 DC CL36'¢ CHANGE ALL WORD ''expose'' ''Expose''¢'
CHARCONST_12 DC CL36'¢ CHANGE ALL WORD ''return'' ''Return''¢'
CHARCONST_13 DC CL36'¢ CHANGE ALL WORD ''SELECT'' ''SELECT''¢'
CHARCONST_14 DC CL36'¢ CHANGE ALL WORD ''signal'' ''Signal''¢'
CHARCONST_15 DC CL36'¢ CHANGE ALL WORD ''source'' ''Source''¢'
CHARCONST_16 DC CL36'¢ CHANGE ALL WORD ''syntax'' ''Syntax''¢'
CHARCONST_17 DC CL34'¢ CHANGE ALL WORD ''error'' ''Error''¢'
CHARCONST_18 DC CL34'¢ CHANGE ALL WORD ''leave'' ''Leave''¢'
CHARCONST_19 DC CL34'¢ CHANGE ALL WORD ''parse'' ''Parse''¢'
CHARCONST_20 DC CL34'¢ CHANGE ALL WORD ''queue'' ''Queue''¢'
CHARCONST_21 DC CL34'¢ CHANGE ALL WORD ''trace'' ''Trace''¢'
CHARCONST_22 DC CL34'¢ CHANGE ALL WORD ''upper'' ''Upper''¢'
CHARCONST_23 DC CL34'¢ CHANGE ALL WORD ''until'' ''Until''¢'
CHARCONST_24 DC CL34'¢ CHANGE ALL WORD ''value'' ''Value''¢'
CHARCONST_25 DC CL34'¢ CHANGE ALL WORD ''while'' ''While''¢'
CHARCONST_26 DC CL33'¢ CHANGE ALL WORD ''exit'' ''Exit'' ¢'
CHARCONST_27 DC CL33'¢ CHANGE ALL WORD ''halt'' ''Halt'' ¢'
CHARCONST_28 DC CL32'¢ CHANGE ALL WORD ''call'' ''Call''¢'
CHARCONST_29 DC CL32'¢ CHANGE ALL WORD ''drop'' ''Drop''¢'
CHARCONST_30 DC CL32'¢ CHANGE ALL WORD ''else'' ''Else''¢'
CHARCONST_31 DC CL32'¢ CHANGE ALL WORD ''pull'' ''Pull''¢'
CHARCONST_32 DC CL32'¢ CHANGE ALL WORD ''push'' ''Push''¢'
CHARCONST_33 DC CL32'¢ CHANGE ALL WORD ''then'' ''Then''¢'
CHARCONST_34 DC CL32'¢ CHANGE ALL WORD ''when'' ''When''¢'
CHARCONST_35 DC CL32'¢ CHANGE ALL WORD ''with'' ''With''¢'
CHARCONST_36 DC CL30'¢ CHANGE ALL WORD ''say'' ''Say''¢'
CHARCONST_37 DC CL30'¢ CHANGE ALL WORD ''arg'' ''Arg''¢'
CHARCONST_38 DC CL30'¢ CHANGE ALL WORD ''end'' ''End''¢'
CHARCONST_39 DC CL30'¢ CHANGE ALL WORD ''nop'' ''Nop''¢'
CHARCONST_40 DC CL30'¢ CHANGE ALL WORD ''var'' ''Var''¢'
CHARCONST_41 DC CL28'¢ CHANGE ALL WORD ''if'' ''If''¢'
CHARCONST_42 DC CL28'¢ CHANGE ALL WORD ''do'' ''Do''¢'
CHARCONST_43 DC CL27'¢ (LAST) = LINENUM .ZLAST ¢'
CHARCONST_44 DC CL24'¢ (STATE) = USER_STATE ¢'
CHARCONST_45 DC CL24'¢ USER_STATE = (STATE) ¢'
CHARCONST_46 DC CL20'¢ (LRECLC) = LRECL ¢'
CL14___MACRO__GO___ DC CL14'¢ MACRO (GO) ¢'
CL12___CAPS_OFF__ DC CL12'¢ CAPS OFF ¢'
CL12___HEX_VERT__ DC CL12'¢ HEX VERT ¢'
CL10___UP_MAX__ DC CL10'¢ UP MAX ¢'
CL9__ZEDSMSG_ DC CL9'(ZEDSMSG)'
CL9__ZEDLMSG_ DC CL9'(ZEDLMSG)'
CL8_VDEFINE DC CL8'VDEFINE '
CL8__LRECLC_ DC CL8'(LRECLC)'
CL8__LINEIN_ DC CL8'(LINEIN)'
CL8_ISREDIT DC CL8'ISREDIT '
CL8_ISRZ001 DC CL8'ISRZ001 '
CL8_VDELETE DC CL8'VDELETE '
CL6__LAST_ DC  CL6'(LAST)'
CL6__LPTR_ DC  CL6'(LPTR)'
CL6_SETMSG DC  CL6'SETMSG'
CL5_FIXED DC   CL5'FIXED'
CL4__GO_ DC    CL4'(GO)'
CL4_CHAR DC    CL4'CHAR'
CL2__    DC    CL2'* '
GO       DS    CL1
LC       DS    CL1
LINEIN   DS    CL255
LRECLC   DS    CL5
ZEDSMSG  DC    CL22'INVALID EXEC'
ZEDLMSG  DC    CL31'This exec is missing an ending '
MISSING  DC    CL23'comment delimiter (*/).',CL26' '
GETLINE  DC    0CL25
GETN1    DS    CL18
GETNUM   DS    CL5
GETN2    DS    CL2
PUTLINE  DC    0CL25
PUTN1    DS    CL7
PUTNUM   DS    CL5
PUTN2    DS    CL13
         DS    CL4
SPFCTFW1 DS    CL8
SPFCTFW2 DS    CL8
SPFCTNW  DS    CL8
SPFCTNX  DS    CL16
FINDXCMD DC    CL9'¢ FIND X'''
OUTCODE  DS    CL2
         DC    CL9''' FIRST ¢'
SPFCTXI  DC    0CL5
SPFCTXID DS    CL4
         DS    CL1
SPFCTXO  DC    0CL9
SPFCTXOD DS    CL8
         DS    CL1
SPFCTXT  DC    CL16'0123456789ABCDEF'
LINEMASK DS    CL255
TRTABLE1 DC 256AL1(*-TRTABLE1)        UPCASE TO JUNK
         ORG TRTABLE1+C'A'
         DC  XL9'010203040506070809'
         ORG TRTABLE1+C'J'
         DC  XL9'0A0B0C0D0E0F101112'
         ORG TRTABLE1+C'S'
         DC  XL8'131415161718191A'
         ORG TRTABLE1+C'a'
         DC  XL9'1B1C1D1E1F20212223'
         ORG TRTABLE1+C'j'
         DC  XL9'2425262728292A2B2C'
         ORG TRTABLE1+C's'
         DC  XL8'2D2E2F3031323334'
         ORG TRTABLE1+256
TRTABLE2 DC 256AL1(*-TRTABLE2)       UPCASE TO LOWCASE
         ORG TRTABLE2+C'A'
         DC  CL9'abcdefghi'
         ORG TRTABLE2+C'J'
         DC  CL9'jklmnopqr'
         ORG TRTABLE2+C'S'
         DC  CL8'stuvwxyz'
         ORG TRTABLE2+256
TRTABLE3 DC 256AL1(*-TRTABLE3)       JUNK TO UPCASE
         ORG TRTABLE3
         DC XL1'00',CL26'ABCDEFGHIJKLMNOPQRSTUVWXYZ'
         DC CL26'abcdefghijklmnopqrstuvwxyz'
         ORG TRTABLE3+256
         END   ,(PL/X-370,0104,00025)