aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

121
Task/Topswops/360-Assembly/topswops.360 Normal file
View file

@ -0,0 +1,121 @@
* Topswops optimized 12/07/2016
TOPSWOPS CSECT
USING TOPSWOPS,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
MVC N,=F'1' n=1
LOOPN L R4,N n; do n=1 to 10 ===-------------==*
C R4,=F'10' " *
BH ELOOPN . *
MVC P(40),PINIT p=pinit
MVC COUNTM,=F'0' countm=0
REPEAT MVC CARDS(40),P cards=p -------------------------+
SR R11,R11 count=0 |
WHILE CLC CARDS,=F'1' do while cards(1)^=1 ---------+
BE EWHILE . |
MVC M,CARDS m=cards(1)
L R2,M m
SRA R2,1 m/2
ST R2,MD2 md2=m/2
L R3,M @card(mm)=m
SLA R3,2 *4
LA R3,CARDS-4(R3) @card(mm)
LA R2,CARDS @card(i)=0
LA R6,1 i=1
LOOPI C R6,MD2 do i=1 to m/2 -------------+
BH ELOOPI . |
L R0,0(R2) swap r0=cards(i)
MVC 0(4,R2),0(R3) swap cards(i)=cards(mm)
ST R0,0(R3) swap cards(mm)=r0
AH R2,=H'4' @card(i)=@card(i)+4
SH R3,=H'4' @card(mm)=@card(mm)-4
LA R6,1(R6) i=i+1 |
B LOOPI ----------------------------+
ELOOPI LA R11,1(R11) count=count+1 |
B WHILE -------------------------------+
EWHILE C R11,COUNTM if count>countm
BNH NOTGT then
ST R11,COUNTM countm=count
NOTGT BAL R14,NEXTPERM call nextperm
LTR R0,R0 until nextperm=0 |
BNZ REPEAT ---------------------------------+
L R1,N n
XDECO R1,XDEC edit n
MVC PG(2),XDEC+10 output n
MVI PG+2,C':' output ':'
L R1,COUNTM countm
XDECO R1,XDEC edit countm
MVC PG+3(4),XDEC+8 output countm
XPRNT PG,L'PG print buffer
L R1,N n *
LA R1,1(R1) +1 *
ST R1,N n=n+1 *
B LOOPN ===------------------------------==*
ELOOPN L R13,4(0,R13) epilog
LM R14,R12,12(R13) " restore
XR R15,R15 " rc=0
BR R14 exit
PINIT DC F'1',F'2',F'3',F'4',F'5',F'6',F'7',F'8',F'9',F'10'
CARDS DS 10F cards
P DS 10F p
COUNTM DS F countm
M DS F m
N DS F n
MD2 DS F m/2
PG DC CL20' ' buffer
XDEC DS CL12 temp
*------- ---- nextperm ----------{-----------------------------------
NEXTPERM L R9,N nn=n
SR R8,R8 jj=0
LR R7,R9 nn
BCTR R7,0 j=nn-1
LTR R7,R7 if j=0
BZ ELOOPJ1 then skip do loop
LOOPJ1 LR R1,R7 do j=nn-1 to 1 by -1; j ----+
SLA R1,2 . |
L R2,P-4(R1) p(j)
C R2,P(R1) if p(j)<p(j+1)
BNL PJGEPJP then
LR R8,R7 jj=j
B ELOOPJ1 leave j |
PJGEPJP BCT R7,LOOPJ1 j=j-1 ---------------------+
ELOOPJ1 LA R7,1(R8) j=jj+1
LOOPJ2 CR R7,R9 do j=jj+1 while j<nn ------+
BNL ELOOPJ2 . |
LR R2,R7 j
SLA R2,2 .
LR R3,R9 nn
SLA R3,2 .
L R0,P-4(R2) swap p(j),p(nn)
L R1,P-4(R3) "
ST R0,P-4(R3) "
ST R1,P-4(R2) "
BCTR R9,0 nn=nn-1
LA R7,1(R7) j=j+1 |
B LOOPJ2 ----------------------------+
ELOOPJ2 LTR R8,R8 if jj=0
BNZ JJNE0 then
LA R0,0 return(0)
BR R14 "
JJNE0 LA R7,1(R8) j=jj+1
LR R2,R7 j
SLA R2,2 r@p(j)
LR R3,R8 jj
SLA R3,2 r@p(jj)
LOOPJ3 L R0,P-4(R2) p(j) ----------------------+
C R0,P-4(R3) do j=jj+1 while p(j)<p(jj) |
BNL ELOOPJ3
LA R2,4(R2) r@p(j)=r@p(j)+4
LA R7,1(R7) j=j+1 |
B LOOPJ3 ----------------------------+
ELOOPJ3 L R1,P-4(R3) swap p(j),p(jj)
ST R0,P-4(R3) "
ST R1,P-4(R2) "
LA R0,1 return(1)
BR R14 ---------------}-----------------------------------
YREGS
END TOPSWOPS