*        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