dstaudacher
dstaudacher

Reputation: 556

How to Sum a Pair of Passed Values Having a '+' or '-' Prefix in Mainframe Assembler?

I have a COBOL program which reads a file containing pairs of right-justified numeric values in character format up to 15 digits long with a leading sign in each and no leading zeros. For example:

     Value One         Value Two             Result 
----+----1----+----2----+----3----+----4----+----5----+
+123456789012345   -123456789012345                  0 
           -2345              +5432              +3087
      +543210987         -789012345         -245801358
+999999999999999   -888888888888888   +111111111111111

I need an Assembler subroutine to calculate the sum of these values and return the result. Can anyone post a sample Assembler subroutine which does this?

Upvotes: 0

Views: 135

Answers (2)

dstaudacher
dstaudacher

Reputation: 556

Solution:

SAMPLE  CSECT 
        SAVE (14,12)        SAVE CALLER REGS 
        LR   12,15          R12 = BASEREG 
        USING SOSAMP,12 
        SR   2,2            R2 = 0 
        LM   3,5,0(1)       R3->NUM1,R4->NUM2,R5->ACCUM OUT 
        LM   6,9,0(3)       SAVE NUM1 CHARS IN R6-R9 
* 
        TRT  0(16,3),HEXTBL FIND THE '+' OR '-' CHAR IN NUM1 
        MVI  0(1),X'40'     OVERLAY WITH SPACE 
        EX   2,SIGN1        SET NUM1 SIGN ACCORDING TO '+' OR '-' 
* 
        TRT  0(16,4),HEXTBL FIND THE '+' OR '-' CHAR IN NUM2
        MVI  0(1),X'40'     OVERLAY WITH SPACE 
        EX   2,SIGN2        SET NUM2 SIGN ACCORDING TO '+' OR '-' 
* 
        PACK 8(8,3),0(16,3) PACK NUM1 
        PACK 0(8,3),0(16,4) PACK NUM2 
        LA   0,C'+'         R0 = C'+' (ASSUMES POSITIVE RESULT)  
        AP   0(8,3),8(8,3)  SUM NUM1 + NUM2 
        BNM  GOEDMK         IF POSITIVE, GO 
        LA   0,C'-'         ELSE R0 = C'-' 
GOEDMK  MVC  0(16,5),EDPAT  MOVE EDIT PATTERN TO RESULT 
        EDMK 0(16,5),0(3)   EDIT AND MARK RESULT 
        BZ   RETURN         IF ZERO, RETURN   
        BCTR 1,0            ELSE R1 MINUS 1 
        STC  0,0(1)         STORE SIGN OF RESULT 
RETURN  SR   15,15          SET RETURN CODE = ZERO 
        STM  6,9,0(3)       RESTORE NUM1 CHARS FROM R6-R9 
        RETURN (14,12),RC=(15) RETURN 
SIGN1   NI   15(3),X'00' 
SIGN2   NI   15(4),X'00' 
EDPAT   DC   X'40202020202020202020202020202120' 
HEXTBL  DC   256X'00' 
        ORG  HEXTBL+C'+' 
        DC   X'CF' 
        ORG  HEXTBL+C'-' 
        DC   X'DF' 
        ORG 
        END  

A COBOL "Driver" program to test with:

IDENTIFICATION DIVISION.                      
PROGRAM-ID. SAMPLEC.                          
ENVIRONMENT DIVISION.                         
INPUT-OUTPUT SECTION.                         
FILE-CONTROL.                                 
    SELECT INFILE ASSIGN INFILE.              
    SELECT OUTFILE ASSIGN OUTFILE.            
DATA DIVISION.                                
FILE SECTION.                                 
FD OUTFILE RECORDING MODE F.                  
01  OUTREC.                                    
    05 PIC X(38).                             
    05 RSLT PIC X(16).                        
FD  INFILE RECORDING MODE F RECORD CONTAINS 0. 
01  INREC.                                    
    05 NUM1 PIC X(16). 05 PIC X(3).           
    05 NUM2 PIC X(16). 05 PIC X(3).           
    05 PIC X(16).                             
WORKING-STORAGE SECTION.                      
01. 05 SAMPLE PIC X(8) VALUE 'SAMPLE'.        
    05 PIC X VALUE 'N'. 88 EOF VALUE 'Y'.                                          
    05 HEADING1 PIC X(52) VALUE                                  
       '     Value One         Value Two             Result'.    
    05 HEADING2 PIC X(55) VALUE                                  
       '----+----1----+----2----+----3----+----4----+----5----+'.
PROCEDURE DIVISION.                                              
    OPEN INPUT INFILE OUTPUT OUTFILE                             
    WRITE OUTREC FROM HEADING1                                   
    WRITE OUTREC FROM HEADING2                                   
    PERFORM READ-INFILE                                          
    PERFORM UNTIL EOF                                            
      MOVE INREC TO OUTREC                                       
      CALL SAMPLE USING NUM1, NUM2, RSLT                         
      WRITE OUTREC                                               
      PERFORM READ-INFILE                                        
    END-PERFORM                                                  
    GOBACK.  
READ-INFILE. READ INFILE AT END SET EOF TO TRUE END-READ.   

And some JCL to run the COBOL driver:

//<jobname> JOB                                         
//JOBLIB DD DISP=SHR,DSN=<sample load library>          
// EXEC PGM=SAMPLEC    
//OUTFILE DD SYSOUT=*                                 
//INFILE DD *                                          
+123456789012345   -123456789012345  
           -2345              +5432  
      +543210987         -789012345  
+999999999999999   -888888888888888  
/*                                                     
//

Upvotes: -2

rcgldr
rcgldr

Reputation: 28921

I assume the goal here is to convert the EBCDIC strings into packed (or maybe unpacked) decimal strings. I'm also assuming that by IBM mainframe, you mean something with 370/390 like instruction set.

Assuming this is homework, you should have documentation for machine level packed (or maybe unpacked) decimal format. For packed decimal, the last "nibble" will hold the "sign". You could also do a web search to find the documentation. Since I'm not sure of which mainframe you're using, I'm suggesting you do a web search, rather then I post a potentially unhelpful link.

I'm not sure if this is an issue, but if an instruction you need has a fixed value operand (like string size) that you need to be variable, use the execute instruction to override that fixed value operand with a variable operand.

To convert from packed decimal back to EBCDIC, use edit and mark type instruction. I don't recall what is used for EBCDIC to pack decimal.

Upvotes: 3

Related Questions