*        Binary search             05/03/2017
BINSEAR  CSECT
         USING  BINSEAR,R13        base register
         B      72(R15)            skip savearea
         DC     17F'0'             savearea
         STM    R14,R12,12(R13)    save previous context
         ST     R13,4(R15)         link backward
         ST     R15,8(R13)         link forward
         LR     R13,R15            set addressability
         MVC    LOW,=H'1'          low=1
         MVC    HIGH,=AL2((XVAL-T)/2)  high=hbound(t)
         SR     R6,R6              i=0
         MVI    F,X'00'            f=false
         LH     R4,LOW             low
       DO WHILE=(CH,R4,LE,HIGH)    do while low<=high
         LA     R6,1(R6)             i=i+1
         LH     R1,LOW               low
         AH     R1,HIGH              +high
         SRA    R1,1                 /2  {by right shift}
         STH    R1,MID               mid=(low+high)/2
         SLA    R1,1                 *2
         LH     R7,T-2(R1)           y=t(mid)
       IF CH,R7,EQ,XVAL THEN         if xval=y then
         MVI    F,X'01'                f=true
         B      EXITDO                 leave
       ENDIF    ,                    endif
       IF CH,R7,GT,XVAL THEN         if y>xval then
         LH     R2,MID                 mid
         BCTR   R2,0                   -1
         STH    R2,HIGH                high=mid-1
       ELSE     ,                    else
         LH     R2,MID                 mid
         LA     R2,1(R2)               +1
         STH    R2,LOW                low=mid+1
       ENDIF    ,                    endif
         LH     R4,LOW               low
       ENDDO    ,                  enddo
EXITDO   EQU    *                exitdo:
         XDECO  R6,XDEC            edit i
         MVC    PG(4),XDEC+8       output i
         MVC    PG+4(6),=C' loops'
         XPRNT  PG,L'PG            print buffer
         LH     R1,XVAL            xval
         XDECO  R1,XDEC            edit xval
         MVC    PG(4),XDEC+8       output xval
       IF CLI,F,EQ,X'01' THEN      if f then
         MVC    PG+4(10),=C' found at '
         LH     R1,MID               mid
         XDECO  R1,XDEC              edit mid
         MVC    PG+14(4),XDEC+8      output mid
       ELSE     ,                  else
         MVC    PG+4(20),=C' is not in the list.'
       ENDIF    ,                  endif
         XPRNT  PG,L'PG            print buffer
         L      R13,4(0,R13)       restore previous savearea pointer
         LM     R14,R12,12(R13)    restore previous context
         XR     R15,R15            rc=0
         BR     R14                exit
T        DC     H'3',H'7',H'13',H'19',H'23',H'31',H'43',H'47'
         DC     H'61',H'73',H'83',H'89',H'103',H'109',H'113',H'131'
         DC     H'139',H'151',H'167',H'181',H'193',H'199',H'229',H'233'
         DC     H'241',H'271',H'283',H'293',H'313',H'317',H'337',H'349'
XVAL     DC     H'229'             <= search value
LOW      DS     H
HIGH     DS     H
MID      DS     H
F        DS     X                  flag
PG       DC     CL80' '            buffer
XDEC     DS     CL12               temp
         YREGS
         END    BINSEAR