Another update from ingydotnet^djgoku

This commit is contained in:
Ingy döt Net 2015-11-18 06:14:39 +00:00
parent 91df62d461
commit 948b86eafa
7604 changed files with 108452 additions and 22726 deletions

View file

@ -0,0 +1,164 @@
* quicksort 14/09/2015
QUICKSOR CSECT
USING QUICKSOR,R15 set base register
BEGIN MVC A,=F'1' a(1)=1
MVC B,=A((A-T)/4) b(1)=hbound(t)
L R6,=F'1' k=1
WHILEK LTR R6,R6 do while k^=0
BZ EWHILEK
LR R1,R6 k
SLA R1,2 ~
L R10,A-4(R1) l=a(k)
LR R1,R6 k
SLA R1,2 ~
L R11,B-4(R1) m=b(k)
BCTR R6,0 k=k-1
LR R4,R11 m
C R4,=F'2' if m<2
BL WHILEK then iterate
LR R2,R10 l
AR R2,R11 +m
BCTR R2,0 -1
ST R2,X x=l+m-1
LR R2,R11 m
SRA R2,1 m/2
AR R2,R10 +l
ST R2,Y y=l+m/2
L R1,X x
SLA R1,2 ~
L R4,T-4(R1) r4=t(x)
L R1,Y y
SLA R1,2 ~
L R5,T-4(R1) r5=t(y)
LR R1,R10 l
SLA R1,2 ~
L R3,T-4(R1) r3=t(l)
IF CR R4,R3 if t(x)<t(l)
BNL ELSE
CR R5,R4 if t(y)<t(x)
BNL IFX
LR R7,R4 p=t(x)
L R1,X x
SLA R1,2 ~
ST R3,T-4(R1) t(x)=t(l)
B EIFX
IFX CR R5,R3 if t(y)>t(l)
BNH IFXELIF
LR R7,R3 p=t(l)
B EIFX
IFXELIF LR R7,R5 p=t(y)
L R1,Y y
SLA R1,2 ~
ST R3,T-4(R1) t(y)=t(l)
EIFX B ENDIF
ELSE CR R5,R3 if t(y)<t(l)
BNL IFY
LR R7,R3 p=t(l)
B ENDIF
IFY CR R5,R4 if t(y)>t(x)
BNH IFYELIF
LR R7,R4 p=t(x)
L R1,X x
SLA R1,2 ~
ST R3,T-4(R1) t(x)=t(l)
B ENDIF
IFYELIF LR R7,R5 p=t(y)
L R1,Y y
SLA R1,2 ~
ST R3,T-4(R1) t(y)=t(l)
ENDIF LA R8,1(R10) i=l+1
L R9,X j=x
FOREVER EQU *
LOOPWI CR R8,R9 i<=j
BH ELOOPWI
LR R1,R8 i
SLA R1,2 ~
L R2,T-4(R1) t(i)
CR R2,R7 t(i)<=p
BH ELOOPWI
LA R8,1(R8) i=i+1
B LOOPWI
ELOOPWI EQU *
LOOPWJ CR R8,R9 i<j
BNL ELOOPWJ
LR R1,R9 j
SLA R1,2 ~
L R2,T-4(R1) t(j)
CR R2,R7 t(j)>=p
BL ELOOPWJ
BCTR R9,0 j=j-1
B LOOPWJ
ELOOPWJ CR R8,R9 if i>=j
BNL EFOREVER then leave segment finished
LR R1,R8 i
SLA R1,2 ~
LA R2,T-4(R1) @t(i)
LR R1,R9 j
SLA R1,2 ~
LA R3,T-4(R1) @t(j)
L R0,0(R2) w=t(i)
MVC 0(4,R2),0(R3) t(i)=t(j) swap t(i),t(j)
ST R0,0(R3) t(j)=w
B FOREVER
EFOREVER LR R9,R8 j=i
BCTR R9,0 j=i-1
LR R1,R9 j
SLA R1,2 ~
LA R3,T-4(R1) @t(j)
L R2,0(R3) t(j)
LR R1,R10 l
SLA R1,2 ~
ST R2,T-4(R1) t(l)=t(j)
ST R7,0(R3) t(j)=p
LA R6,1(R6) k=k+1
LR R1,R6 k
SLA R1,2 ~
LA R4,A-4(R1) r4=@a(k)
LA R5,B-4(R1) r5=@b(k)
C R8,Y if i<=y
BH IFIHY
ST R8,0(R4) a(k)=i
L R2,X x
SR R2,R8 -i
LA R2,1(R2) +1
ST R2,0(R5) b(k)=x-i+1
LA R6,1(R6) k=k+1
ST R10,4(R4) a(k)=l
LR R2,R9 j
SR R2,R10 -l
ST R2,4(R5) b(k)=j-l
B EIFIHY
IFIHY ST R10,4(R4) a(k)=l
LR R2,R9 j
SR R2,R10 -l
ST R2,0(R5) b(k)=j-l
LA R6,1(R6) k=k+1
ST R8,4(R4) a(k)=i
L R2,X x
SR R2,R8 -i
LA R2,1(R2) +1
ST R2,4(R5) b(k)=x-i+1
EIFIHY B WHILEK
EWHILEK LA R3,PG ibuffer
LA R4,T @t(i)
LOOPI C R4,=A(A) do i=1 to hbound(t)
BH ELOOPI
L R2,0(R4) t(i)
XDECO R2,XD edit t(i)
MVC 0(4,R3),XD+8 put in buffer
LA R3,4(R3) ibuffer=ibuffer+1
LA R4,4(R4) i=i+1
B LOOPI
ELOOPI XPRNT PG,80 print bufffer
RETURN XR R15,R15 set return code
BR R14 return to caller
T DC F'10',F'9',F'9',F'6',F'7',F'16',F'1',F'16',F'17',F'15'
DC F'1',F'9',F'18',F'16',F'8',F'20',F'18',F'2',F'19',F'8'
A DS ((A-T)/4)F same size as T
B DS ((A-T)/4)F same size as T
X DS F
Y DS F
PG DS CL80
XD DS CL12
YREGS
END QUICKSOR