RosettaCodeData/Task/Binary-search/360-Assembly/binary-search.360

72 lines
3.1 KiB
Plaintext

* 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