Reputation: 556
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
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
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