RosettaCodeData/Task/Knapsack-problem-Unbounded/360-Assembly/knapsack-problem-unbounded.360

198 lines
7.6 KiB
Plaintext

* Knapsack problem/Unbounded 04/02/2017
KNAPSACK CSECT
USING KNAPSACK,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 S,=F'0' s(1,kva)=0;
LA R11,0 ns=0
LA R1,KW kw
SLA R1,2 *4
L R2,PANACEA-4(R1) panacea(kw)
L R4,SACKW sackw
SRDA R4,32 ~
DR R4,R2 sackw/panacea(kw)
ST R5,XP xp=sackw/panacea(kw)
LA R1,KV kv
SLA R1,2 *4
L R2,PANACEA-4(R1) panacea(kv)
L R4,SACKV sackv
SRDA R4,32 ~
DR R4,R2 r5=sackv/panacea(kv)
C R5,XP if r5<xp
BNL EMINXP
ST R5,XP xp=min(sackw/panacea(kw),sackv/panacea(kv))
EMINXP LA R1,KW kw
SLA R1,2 *4
L R2,ICHOR-4(R1) ichor(kw)
L R4,SACKW sackw
SRDA R4,32 ~
DR R4,R2 sackw/ichor(kw)
ST R5,XI xi=sackw/ichor(kw)
LA R1,KV kv
SLA R1,2 *4
L R2,ICHOR-4(R1) ichor(kv)
L R4,SACKV sackv
SRDA R4,32 ~
DR R4,R2 r5=sackv/ichor(kv)
C R5,XI if r5<xi
BNL EMINXI
ST R5,XI xi=min(sackw/ichor(kw),sackv/ichor(kv))
EMINXI LA R1,KW kw
SLA R1,2 *4
L R2,GOLD-4(R1) gold(kw)
L R4,SACKW sackw
SRDA R4,32 ~
DR R4,R2 sackw/gold(kw)
ST R5,XG xg=sackw/gold(kw)
LA R1,KV kv
SLA R1,2 *4
L R2,GOLD-4(R1) gold(kv)
L R4,SACKV sackv
SRDA R4,32 ~
DR R4,R2 r5=sackv/gold(kv)
C R5,XG if r5<xg
BNL EMINXG
ST R5,XG xg=min(sackw/gold(kw),sackv/gold(kv))
EMINXG SR R10,R10 ip=0
LOOPIP C R10,XP do ip=0 to xp
BH ELOOPIP
SR R9,R9 ii=0
LOOPII C R9,XI do ii=0 to xi
BH ELOOPII
SR R8,R8 ig=0
LOOPIG C R8,XG do ig=0 to xg
BH ELOOPIG
LA R7,KVA m=kva
LOOPM C R7,=A(KV) do m=kva to kv
BH ELOOPM
LR R1,R7 m
SLA R1,2 *4
LR R5,R8 ig
M R4,GOLD-4(R1) *gold(m)
LR R2,R5 r2=ig*gold(m)
LR R5,R9 ii
M R4,ICHOR-4(R1) *ichor(m)
AR R2,R5 r2=ig*gold(m)+ii*ichor(m)
LR R5,R10 ip
M R4,PANACEA-4(R1) *panacea(m)
AR R2,R5 r2=r2+ip*panacea(m)
ST R2,CUR-4(R1) cur(m)=r2
LA R7,1(R7) m=m+1
B LOOPM
ELOOPM LA R1,KVA kva
SLA R1,2 *4
L R2,CUR-4(R1) cur(kva)
C R2,S-4(R1) if cur(kva)>=s(1,kva)
BL ENDIF
LA R1,KW kw
SLA R1,2 *4
L R2,CUR-4(R1) cur(kw)
C R2,SACKW if cur(kw)<=sackw
BH ENDIF
LA R1,KV kv
SLA R1,2 *4
L R2,CUR-4(R1) cur(kv)
C R2,SACKV if cur(kv)<=sackv
BH ENDIF
LR R6,R11 j=ns
LOOPJ C R6,=F'1' do j=ns to 1 by -1
BL ELOOPJ
LR R1,R6 j
MH R1,=H'24' *24
LA R2,S(R1) s(j+1,1)
LA R3,S-24(R1) s(j,1)
MVC 0(24,R2),0(R3) s(j+1,*)=s(j,*)
BCTR R6,0 j=j-1
B LOOPJ
ELOOPJ LA R1,KVA kva
SLA R1,2 *4
L R2,CUR-4(R1) cur(kva)
ST R2,S-4(R1) s(1,kva)=cur(kva)
LA R1,KW kw
SLA R1,2 *4
L R2,CUR-4(R1) cur(kw)
ST R2,S-4(R1) s(1,kw)=cur(kw)
LA R1,KV kv
SLA R1,2 *4
L R2,CUR-4(R1) cur(kv)
ST R2,S-4(R1) s(1,kv)=cur(kv)
LA R1,KP kp
SLA R1,2 *4
ST R10,S-4(R1) s(1,kp)=ip
LA R1,KI ki
SLA R1,2 *4
ST R9,S-4(R1) s(1,ki)=ii
LA R1,KG kg
SLA R1,2 *4
ST R8,S-4(R1) s(1,kg)=ig
L R2,S r2=s(1,1)
C R2,S+24 if s(1,1)>s(2,1)
BNH ELSE
LA R11,1 ns=1
B ENDIF
ELSE LA R11,1(R11) ns+1
ENDIF LA R8,1(R8) ig=ig+1
B LOOPIG
ELOOPIG LA R9,1(R9) ii=ii+1
B LOOPII
ELOOPII LA R10,1(R10) ip=ip+1
B LOOPIP
ELOOPIP XPRNT TITLE,72
LA R6,1 j=1
LA R3,S-4 r3=@item
LOOPJP CR R6,R11 do j=1 to ns
BH ELOOPJP
LA R3,4(R3) ++
L R1,0(R3) s(j,kva)
XDECO R1,PG edit
LA R3,4(R3) ++
L R1,0(R3) s(j,kw)
XDECO R1,PG+12 edit
LA R3,4(R3) ++
L R1,0(R3) s(j,kv)
XDECO R1,PG+24 edit
MVC PG+20(2),PG+21 shift
MVI PG+22,C'.' decimal point
LA R3,4(R3) ++
L R1,0(R3) s(j,kp)
XDECO R1,PG+36 edit
MVC PG+31(2),=C'0.' decimal point
LA R3,4(R3) ++
L R1,0(R3) s(j,ki)
XDECO R1,PG+48 edit
LA R3,4(R3) ++
L R1,0(R3) s(j,kg)
XDECO R1,PG+60 edit
XPRNT PG,L'PG print buffer
LA R6,1(R6) j=j+1
B LOOPJP
ELOOPJP L R13,4(0,R13) epilog
LM R14,R12,12(R13) " restore
XR R15,R15 " rc=0
BR R14 exit
KVA EQU 1
KW EQU 2
KV EQU 3
KP EQU 4
KI EQU 5
KG EQU 6
SACKW DC F'250'
SACKV DC F'250'
PANACEA DC F'3000',F'3',F'25'
ICHOR DC F'1800',F'2',F'15'
GOLD DC F'2500',F'20',F'2'
XP DS F
XI DS F
XG DS F
CUR DS 3F
S DS 60F
TITLE DC CL36' Value Weight Volume'
DC CL36' Panacea Ichor Gold'
PG DS CL72
YREGS
END KNAPSACK