PRINT NOGEN                                                   
****************************************************************
*        FILENAME:  COGS16A.MLC                                *
*        AUTHOR  :  Bill Qualls                                *
*        SYSTEM  :  Compaq 286LTE, PC/370 R4.2                 *
*        REMARKS :  Determine nationwide dollar sales for      *
*                   COGSWORTH INDUSTRIES.                      *
*                   This is a modification of COGS13A.MLC and  *
*                   illustrates binary multiplication.         *
****************************************************************
         START 0                                                       
         REGS
BEGIN    BEGIN
         WTO   'COGS16A ... Begin execution'
         BAL   R10,SETUP
MAIN     EQU   *
         CLI   EOFSW,C'Y'
         BE    EOJ
         BAL   R10,PROCESS
         B     MAIN
EOJ      EQU   *
         BAL   R10,WRAPUP
         WTO   'COGS16A ... Normal end of program'
         RETURN
****************************************************************
*        SETUP - Those things which happen one time only,      *
*                before any records are processed.             *
****************************************************************
SETUP    EQU   *
         ST    R10,SVSETUP
         OPEN  INVENTRY           Input is EBCDIC, no CR/LF
         BAL   R10,READ
         L     R10,SVSETUP
         BR    R10
****************************************************************
*        READ - Read a record.                                 *
****************************************************************
READ     EQU   *
         ST    R10,SVREAD
         GET   INVENTRY,IREC      Read a single product record
         B     READX
ATEND    EQU   *
         MVI   EOFSW,C'Y'
READX    EQU   *
         L     R10,SVREAD
         BR    R10
****************************************************************
*        PROCESS - Those things which happen once per record.  *
****************************************************************
PROCESS  EQU   * 
         ST    R10,SVPROC
         LH    R3,ICALIF          Determine total units
         AH    R3,IILL             sold for this product
         AH    R3,IUTAH
         AH    R3,IWISC
         MH    R3,ISELL           Multiply units by price
         A     R3,TOTAL           Add total thus far
         ST    R3,TOTAL            then save back.
         BAL   R10,READ
         L     R10,SVPROC
         BR    R10
****************************************************************
*        WRAPUP - Those things which happen one time only,     *
*                 after all records have been processed.       *
****************************************************************
WRAPUP   EQU   *
         ST    R10,SVWRAP
         L     R3,TOTAL           Must put it in a register
         CVD   R3,DBLWORD          to convert it to packed.
         ED    ODOLLARS,DBLWORD+4
         WTO   OMSG        
         CLOSE INVENTRY
         L     R10,SVWRAP
         BR    R10
****************************************************************
*        Literals, if any, will go here                        *
****************************************************************
         LTORG
****************************************************************
*        File definitions                                      *
****************************************************************
INVENTRY DCB   LRECL=28,RECFM=F,MACRF=G,EODAD=ATEND,
               DDNAME='COGS.BIN'  
****************************************************************
*        RETURN ADDRESSES                                      *
****************************************************************
SVSETUP  DC    F'0'               SETUP
SVPROC   DC    F'0'               PROCESS
SVREAD   DC    F'0'               READ
SVWRAP   DC    F'0'               WRAPUP
****************************************************************
*        Miscellaneous field definitions                       *
****************************************************************
EOFSW    DC    CL1'N'             End of file? (Y/N)
TOTAL    DC    F'0'               Nationwide dollar sales
DBLWORD  DC    D'0'
****************************************************************
*        Input record definition                               *
****************************************************************
         DS    0H                 Force halfword alignment
IREC     DS    0CL28        1-28  Inventory record
IDESC    DS    CL10         1-10  Product description
ICALIF   DS    H           11-12  Units sold in Calif
IILL     DS    H           13-14  Units sold in Illinois
IUTAH    DS    H           15-16  Units sold in Utah
IWISC    DS    H           17-18  Units sold in Wisconsin
IBEGIN   DS    H           19-20  Beginning inventory
IPURCH   DS    H           21-22  Purchases throughout year
IQOH     DS    H           23-24  Actual quantity on hand
ICOST    DS    H           25-26  Cost (each) 99V99
ISELL    DS    H           27-28  Sell for (each) 99V99
****************************************************************
*        Output message definition                             *
****************************************************************
OMSG     DS    0CL49                  
         DC    CL39'COGS16A ... Nationwide dollar sales are'
ODOLLARS DC    XL10'4020206B2021204B2020'   BZZ,ZZ9.99
         END   BEGIN