September 2017 Update

Task/ABC-Problem/360-Assembly/abc-problem.360

@@ -0,0 +1,76 @@
+*        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