*        ABC Problem               21/07/2016
ABC      CSECT
         USING  ABC,R13            base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         STM    R14,R12,12(R13)    prolog
         ST     R13,4(R15)         " <-
         ST     R15,8(R13)         " ->
         LR     R13,R15            " addressability
         LA     R8,1               l=1
LOOPL    C      R8,=A(NN)          do l=1 to hbound(words)
         BH     ELOOPL
         LR     R1,R8              l
         MH     R1,=H'20'          *20
         LA     R10,WORDS-20(R1)   @words(l)
         MVC    STATUS,=CL5'true'  cflag='true'
         MVC    TBLOCKS,BLOCKS     tblocks=blocks
         MVC    CC(1),0(R10)       cc=substr(words(l),1,1)
         LA     R6,1               i=1
LOOPI    CLI    CC,C' '            do while cc<>' '
         BE     ELOOPI
         SR     R7,R7              k=0
         LH     R0,=H'1'           m=1
LOOPM    CH     R0,=AL2(L'TBLOCKS) do m=1 to length(tblocks)
         BH     ELOOPM
         LA     R5,TBLOCKS-1       @tblocks[0]
         AR     R5,R0              @tblocks[m]
         CLC    0(1,R5),CC         if substr(tblocks,m,1)=cc
         BNE    INDEXM
         LR     R7,R0              k=m=index(tblocks,cc)
         B      ELOOPM
INDEXM   AH     R0,=H'1'           m=m+1
         B      LOOPM
ELOOPM   LTR    R7,R7              if k=0
         BNZ    OKK
         MVC    STATUS,=CL5'false' cflag='false'
         B      EIFK0
OKK      LA     R4,TBLOCKS-2       @tblocks[-1]
         AR     R4,R7              +k
         CLI    0(R4),C'('         if substr(tblocks,k-1,1)='('
         BNE    SECOND
         LA     R0,1               j=1
         B      EIFBLOCK
SECOND   LA     R0,3               j=3
EIFBLOCK LR     R2,R7              k
         SR     R2,R0              k-j
         LA     R4,TBLOCKS-1       @tblocks[0]
         AR     R4,R2              @tblocks[k-j]
         MVC    0(5,R4),=CL5' '    substr(tblocks,k-j,5)='     '
EIFK0    LA     R6,1(R6)           i=i+1
         LR     R4,R10             @words
         AR     R4,R6              +i
         BCTR   R4,0               -1
         MVC    CC,0(R4)           cc=substr(words,i,1)
         B      LOOPI
ELOOPI   MVC    PG(20),0(R10)      tabword(l)
         MVC    PG+20(5),STATUS    status
         XPRNT  PG,80              print buffer
         LA     R8,1(R8)           l=l+1
         B      LOOPL
ELOOPL   L      R13,4(0,R13)       epilog
         LM     R14,R12,12(R13)    " restore
         XR     R15,R15            " rc=0
         BR     R14                exit
WORDS    DC     CL20'A',CL20'BARK',CL20'BOOK',CL20'TREAT',CL20'COMMON'
         DC     CL20'SQUAD',CL20'CONFUSE'
BLOCKS   DS     0CL122
 DC CL61'((B O) (X K) (D Q) (C P) (N A) (G T) (R E) (T G) (Q D) (F S) '
 DC CL61'(J W) (H U) (V I) (A N) (O B) (E R) (F S) (L Y) (P C) (Z M)) '
TBLOCKS  DS     CL(L'BLOCKS)       work blocks
CC       DS     CL1                letter to find
STATUS   DS     CL5                true/false
PG       DC     CL80' '            buffer
         YREGS
NN       EQU    (BLOCKS-WORDS)/L'WORDS  number of words
         END    ABC