MULTIPLY doesn't behave as I would expect - cobol

I have this cobol program, meant to calculate a factorial:
IDENTIFICATION DIVISION.
PROGRAM-ID. Factorial-hopefully.
AUTHOR. Darth Egregious.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 Keeping-Track-Variables.
05 Operand PIC S99 VALUE 0.
05 Product PIC S99 VALUE 1.
PROCEDURE DIVISION.
PERFORM-FACTORIAL.
DISPLAY SPACES
PERFORM VARYING Operand FROM 6 BY -1 UNTIL Operand = 0
DISPLAY "Before Product " Product " Operand " Operand
MULTIPLY Product By Operand GIVING Product
DISPLAY "After Product " Product " Operand " Operand
END-PERFORM
DISPLAY Product.
STOP RUN.
I run it like this:
cobc -free -x -o a.out fact.cbl && ./a.out
And I get this strange output:
Before Product +01 Operand +06
After Product +06 Operand +06
Before Product +06 Operand +05
After Product +30 Operand +05
Before Product +30 Operand +04
After Product +30 Operand +04
Before Product +30 Operand +03
After Product +90 Operand +03
Before Product +90 Operand +02
After Product +90 Operand +02
Before Product +90 Operand +01
After Product +90 Operand +01
+90
My decrementing loop is working as expected, but the MULTIPLY command is behaving strangely. It's doing 1*6, and 6*5 correctly, but 30*4 doesn't seem to work, then 30*3 does, and finally 90*2 doesn't work again. Does COBOL not like multiplying by powers of two or something?

My decrementing loop is working as expected, but the MULTIPLY command is behaving strangely. It's doing 1*6, and 6*5 correctly, but 30*4 doesn't seem to work, then 30*3 does, and finally 90*2 doesn't work again. Does COBOL not like multiplying by powers of two or something?
05 Operand PIC S99 VALUE 0.
05 Product PIC S99 VALUE 1.
When you are multiplying 30*4 and 90*2, the values are larger than the PICTURE clause, S99.
Increase the size of the PIC clause to, say, S999.
Response to comments:
Technically, the result is undefined [COBOL 85], therefore doing nothing is a valid choice. Other implementations will truncate the value giving a different result.
So it isn't so much the language as it is the implementation.
The language also allows the SIZE ERROR phrase to catch truncation errors. In that situation, the result is unaltered, but additional code may be executed to indicate that the error occurred.
With COBOL 2002, the result is defined by the implementor, if the ON SIZE ERROR phrase isn't specified and checking of the EC-SIZE-TRUNCATION exception is not active.
Quote from 2002 standard:
F.1 Substantive changes potentially affecting existing programs
15) Size error condition with no SIZE ERROR phrase. If a size error condition occurs, the statement in which it occurs contains no SIZE ERROR or NOT SIZE ERROR phrase, and there is no associated declarative, the implementor defines whether the run unit is terminated or execution continues with incorrect values.
Justification:
In the previous COBOL standard, the rules for size error stated that execution would continue with undefined values, but it was not clear where execution would continue, particularly in conditional statements. Additionally, continued execution with incorrect results was not acceptable for many critical applications, where it might cause corruption of databases, incorrect continued execution of the program, and potentially a multitude of additional errors. It was prohibitive to modify programs to add ON SIZE ERROR for every affected statement. Responding to user requirements, several implementors terminated execution of the program in this situation; in some cases, the implementor allowed selection of termination based on a compiler directive.
The number and criticality of applications that terminated in this situation provides strong justification for this change. It is expected that this change will have little impact on existing programs because implementors are free to continue or terminate, in accordance with their implementation of the previous COBOL standard.

Related

COBOL function output as string

123456*
IDENTIFICATION DIVISION.
PROGRAM-ID. "EVEN-OR-ODD".
DATA DIVISION.
WORKING-STORAGE SECTION.
01 Num-1 PIC 9(02).
02 Answer PIC XXXX.
PROCEDURE DIVISION.
GOBACK.
EVEN-OR-ODD.
IF FUNCTION REM(NUM-1, 2) = 0
COMPUTE ANSWER = "Even"
ELSE
COMPUTE ANSWER = "Odd"
END-IF
END PROGRAM EVEN-OR-ODD.
Its a simple even odd function. It should check if number is even return "even" else return "odd"
Can someone explain what's wrong ?
So much things a COBOL compiler would have told you...
GOBACK as first statement, so the rest would not be executed
the program misses a final period and a necessary/reasonable (that depends on the compiler) statement to end the program (END PROGRAM is only parsed for the compilation phase) - you likely want to move your GOBACK. to the end
COMPUTE does not set anything to alphanumeric, you likely want MOVE
there is no way to know what the program would have done, so possibly want DISPLAY instead of MOVE
NUM-1 is never set and has no initial VALUE - so it could theoretically even abend

Compute: Warn when low-order truncation occurs

I have a result field specified as
01 MY-RESULT VALUE +0 USAGE COMP-3 PIC S9(13)V99
Imagine I multiply two factors:
COMPUTE MY-RESULT = A * B
What is the best way to detect low-order truncation in MY-RESULT?
E.g. when A=B=2.01.
The ON SIZE ERRORclause is not triggered.
Something that will work with all vendors and even the oldest compilers (as you did not specified any dialect the seems to be the most important part): if it matters use an additional target field with more decimal positions and check for equality afterwards:
COMPUTE MY-RESULT RESULT-WITH-MORE-DECIMALS = A * B
IF MY-RESULT NOT = RESULT-WITH-MORE DECIMALS
...
END-IF
ON SIZE ERROR will only be tracked for the upper truncation.
If this 2014 feature os available for your compiler you could use the INTERMEDIATE ROUNDING IS PROHIBITED (the draft had it in as ROUNDED-MODE PROHIBITED) which will show you this problem (if EC-SIZE-TRUNCATION exception is enabled). Beware of one part: this is an exception with a "fatal" category...

Why doesn't GnuCOBOL's rounding syntax compile?

I would be very grateful for any pointer towards what exactly it is that I am doing wrong with the very minimal, very trivial COBOL program below. It performs a rounding of a result with COBOL's standard tool, the language element ROUNDED. The ulterior motive is to build a large application and apply a time metric to different modes of rounding, given a long series of operations and subsequent roundings for each mode. (The even more ulterior motive is to learn COBOL backwards, this is only a project within that plan, and then try to land a job using and developing COBOL).
The program is listed below. It performs one simple addition, and the result is passed to a variable with a smaller data width which enforces rounding.
000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. ROUNDINGTEST.
000300 ENVIRONMENT DIVISION.
000400 DATA DIVISION.
000500 WORKING-STORAGE SECTION.
000600 01 OPERAND01 PIC S9(2)V9(4) VALUE 1.4745.
000610 01 OPERAND02 PIC S9(2)V9(4) VALUE 1.9874.
000610 01 RESULT PIC S9(2)V9(2).
000700 PROCEDURE DIVISION.
000800 PROGRAM-BEGIN.
000900 COMPUTE RESULT ROUNDED MODE NEAREST-EVEN
001000 = OPERAND01 + OPERAND02
001010 END-COMPUTE
001020
001100 PROGRAM-DONE.
001200 STOP RUN.
Compilation with GnuCOBOL's compiler, as below, gives the results below.
martin#martin-1001PX:~/CobolProjects$ cobc -b ROUNDINGTEST.cob
ROUNDINGTEST.cob: In paragraph 'PROGRAM-BEGIN':
ROUNDINGTEST.cob:11: Error: syntax error, unexpected MODE
martin#martin-1001PX:~/CobolProjects$
No exchange of the indicated mode to any other, Truncation, Towards-Lesser...produces any change. Commenting out lines 000900, 001000 and 001010 gives an error-free response, so clearly the problem is not a cascading problem from earlier in the code or any kind of syntactical mishap later – it's the rounding that doesn't work.
GNU COBOL 2.0 (Formerly OpenCOBOL) [11FEB2012 Version] Programmer’s Guide
2nd Edition, 21 November 2013
has the COMPUTE syntax as below
COMPUTE { identifier-1 [ rounding-option ] } … =|EQUAL
arithmetic-expression-1 [ size-error-clause ] [ END-COMPUTE ]
and the syntax of the qualifier ROUNDED (the rounding-option above) as
AWAY-FROM-ZERO
NEAREST-AWAY-FROM-ZERO
NEAREST-EVEN
ROUNDED MODE IS NEAREST-TOWARD-ZERO
PROHIBITED
TOWARD-GREATER
TOWARD-LESSER
TRUNCATION
where the “IS” is a non-mandatory readability option.
Compact and trivial as this might seem, no amount of revision or testing has availed me to any success. Any meaningful communication on the matter would be much appreciated.
(This should likely be a comment, not an answer, but wanted the code listing to show up).
This works, as Bill pointed out:
000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. ROUNDINGTEST.
000300 ENVIRONMENT DIVISION.
000400 DATA DIVISION.
000500 WORKING-STORAGE SECTION.
000600 01 OPERAND01 PIC S9(2)V9(4) VALUE 1.4745.
000610 01 OPERAND02 PIC S9(2)V9(4) VALUE 1.9874.
000610 01 RESULT PIC S9(2)V9(2).
000700 PROCEDURE DIVISION.
000800 PROGRAM-BEGIN.
000900 COMPUTE RESULT ROUNDED MODE NEAREST-EVEN
001000 = OPERAND01 + OPERAND02
001010 END-COMPUTE
001020 .
001100 PROGRAM-DONE.
001200 STOP RUN.
The period on 1020 changes the state of the compiler from looking for another statement in the paragraph to looking for a new paragraph or statement, which might be a label.

How to display an absolute value

Given the following code:
IDENTIFICATION DIVISION.
PROGRAM-ID. FABS.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 NUM PIC 9 VALUE ZEROS.
01 ABSVAL PIC 99 VALUE ZEROS.
PROCEDURE DIVISION.
PROGRAM-BEGIN.
DISPLAY "This program returns the absolute value of a number.".
DISPLAY SPACE.
DISPLAY "Input value: " WITH NO ADVANCING.
ACCEPT NUM.
IF (NUM = -0) THEN
COMPUTE ABSVAL = 0
ELSE
IF (NUM > 0) THEN
COMPUTE ABSVAL = 0
ELSE
COMPUTE ABSVAL = ABSVAL * -1
END-IF
END-IF.
DISPLAY "|", NUM "| = ", ABSVAL.
PROGRAM-DONE.
STOP RUN.
Why is the output zero? Is there something wrong? And how do you make a signed/negative input?
Thinking of your task, rather than why you get zero, it is easy.
Let's assume you get a signed value with your ACCEPT.
01 value-from-accept PIC S9.
01 absolute-value-for-output PIC 9.
MOVE value-from-accept TO absolute-value-for-output
DISPLAY
"|"
value-from-accept
"| = "
absolute-value-for-output
You may think that something is wrong with the output from value-from-accept (depending on compiler) but you can always MOVE it to a numeric-edited field and DISPLAY that.
Tip: To reverse the sign of a signed field.
SUBTRACT field-to-reverse-sign
FROM ZERO
GIVING the-reversed-field
SUBTRACT is faster than MULTIPLY.
You have defined your field which is ACCEPTed as unsigned.
The first two "legs" of your nested-IF set ABSVAL to zero. The remaining leg takes the existing value of ABSVAL (from the VALUE ZEROS, so it is zero) and multiplies it by minus one. Getting -ve zero (possibly), but then storing it in an unsigned field. So ABSVAL will always be zero when you come to the DISPLAY.
You define a signed field by prefixing the PICture string with an S:
01 a-signed-field PIC S9(5).
Depending on your compiler, you can type a - when entering the data and it'll be held happily as a negative value in a signed field (which you have to define) or you have to code for it yourself.
after your correction above
I am not sure how you are testing it but to just to ensure that the values are stored correct you may want to have both the fields signed i.e. pic S9 or pic S99. Its possible that without the preceding S (sign) the variables are not really storing the negative sign regardless of what the screen is showing.
pls observe what results you get then

Why is my if statement not determining the correct output in two nested performs?

I have this Cobol paragraph that will search one table which at this point in my example would have a table counter of 2 which is what the first INDEX loop does. The variable A represents an Occurs that is defined in a file (include) which has 5 occurrences. I can get to the if statement but it returns false. I read the information out of a ParmCard and store that in the table which is Table-B and the ParmCard is correct.
I did get it to find one value when was changing values around (conditional statements) but I know that both of the values that it is looking for in the ParmCard are in the file and should be found and it should find two results. I would have tried Expeditor but the system was down at work.
Is there something wrong with the index or may be I think that the perform's are working one way but they are really working a different way? This Search paragraph gets executed with every read of the ID file thus it will look in the table as many times as the ID file has an ID and ID symbols are unique.
Question: Why would the IF-STATEMENT not be working?
Code:
SEARCH-PARAGRAPH.
PERFORM VARYING SUB FROM 1 BY 1 UNTIL SUB > 2 <--DUPLICATE INDEXER
IF A(TAB) = TABLE-B(SUB) THEN
MOVE 6 TO TAB
MOVE 'TRUE' TO FOUND-IS
PERFORM WRITE-FILE THRU X-WF
PERFORM LOG-RESULT THRU X-LR
END-IF
END-PERFORM
X-SP. EXIT.
SEARCH-INDEX.
PERFORM VARYING I FROM 1 BY 1 UNTIL I > 2
DISPLAY 'INDEX --> ' I
PERFORM VARYING TAB FROM 1 BY 1 UNTIL TAB > 5
DISPLAY 'TAB --> ' TAB
PERFORM SEARCH-PARAGRPAH THRU X-SP
END-PERFORM
END-PERFORM.
X-SEARCH-INDEX. EXIT.
Here is the way that it works now and I do get the results I want. It is difficult to past the company code up because you never know who might have a problem.
New Code:
READ-PROV.
READ P-FILE
AT END
MOVE 'Y' TO EOF2
GO TO X-READ-PROV
NOT AT END
ADD 1 TO T-REC-READ
MOVE P-RECORD TO TEST-RECORD
PERFORM CHECK-MATCH THRU X-CHECK-MATCH
END-READ.
X-READ-PROV. EXIT.
CHECK-MATCH.
PERFORM VARYING SUB FROM 1 BY 1 UNTIL SUB > TABLECOUNTER
IF PID >= FROM(SUB) AND
PID <= THRU(SUB) THEN
IF TODAY < P-END-DTE THEN
IF TOTAL-PD = 0 AND
TOTAL-PD = 0 AND
TOTAL-PD = 0 AND
TOTAL-PD = 0 AND
TOTAL-PD = 0 THEN
IF PBILLIND NOT EQUAL 'Y'
PERFORM VARYING TAB FROM 1 BY 1 UNTIL TAB > 5
IF P-CD(TAB) = TY(SUB) THEN
MOVE 6 TO TAB
DISPLAY('***Found***')
ADD 1 TO T-REC-FOUND
END-IF
END-PERFORM
END-IF
END-IF
END-IF
END-IF
END-PERFORM.
X-CM. EXIT.
We can't tell.
There is nothing "wrong" with your nested PERFORM. The IF test is failing simply because it is never true.
We can't get you further with that without seeing your data-definitions, sample input and expected output.
However... my guess would be that the problem is with your data from the PARM in the JCL. That is the most likely area.
It is of course possible that the problem is with the other definition.
A couple of things whilst waiting.
Please always post the actual code, always. We don't want to look for errors in what you have typed here, we want to see the actual code. You have not shown the actual code, because it will not compile, as INDEX is a Reserved Word in COBOL, so you can't use it for a data-name.
Please always bear in mind that what you think may be wrong may not be the problem, so post everything we are likely to need (data-definitions, data you used, actual results you got with the code (including anything you've added for problem-determination), results which were expected).
Some tips.
A paragraph requires a full-stop/period after the paragraph-name and before the next paragraph. If you put that second full-stop/period on a line of its own, and have no full-stops/periods attached to your PROCEDURE code itself, you'll make things look neater and avoid problems when you want to copy some lines which happen to have a full-stop/period to a place where they cause you a mess.
You are using literal values. This is bad. When the number of entries in one of your tables changes, you have to change those literal values. Say the 2 needs to be changed to 5. You have to look at every occurrence of the literal 2 and decide if it needs to be changed. Then change it to 5. Then you get another request, to change the table which originally had five entries so that it will have six. See how difficult/error-prone life can be?
If instead you have unique and well-named data-names for your maximum number of entries, you only have one place to make a change, and you know it can be changed without reference to the rest of the code (assuming someone clever hasn't seen it has a value they want for something, and use it despite its name, of course...).
The content of those fields you can set automatically:
01 TABLE-1.
05 FILLER OCCURS 2 TIMES.
10 A PIC X(10).
01 TABLE-2.
05 FILLER OCCURS 5 TIMES.
10 TABLE-B PIC X(10).
01 TABLE-1-NO-OF-ENTRIES COMP PIC 9(4).
01 TABLE-2-NO-OF-ENTRIES COMP PIC 9(4).
...
PROCEDURE DIVISION.
...
COMPUTE TABLE-1-NO-OF-ENTRIES = LENGTH OF TABLE-1
/ LENGTH OF A
COMPUTE TABLE-2-NO-OF-ENTRIES = LENGTH OF TABLE-2
/ LENGTH OF TABLE-B
DISPLAY TABLE-1-NO-OF-ENTRIES
DISPLAY TABLE-2-NO-OF-ENTRIES
That gives you the output 2 and 5.
The names I've used are a mixture of yours and some for demonstration purposes only. Make everything meaningful, and by that I don't mean trite, as my example names would be in real life.
If you insist on escaping from within your PERFORM like that (and take note of Bruce Martin's comment), you can calculate your escape value by using new, aptly-named, fields and giving them the value of the above plus one.
To do a nested loop when the outer loop only has two entries is overkill. You don't need to escape out of the loops like you do, if you have a termination condition on the loop.
That'll do for now until we see your definitions, data and results.

Resources