COBOL function output as string - cobol

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

Related

Microfocus animator says "perform level=01" even though the program it is presently in is a subprogram and called from another program

I am facing a problem while debugging a COBOL program, When using animator and when a call is made to another COBOL program with a CALL ... USING statement.
After entering the sub program and pressing P (for Perform) E (for Exit). The animator asks "Perform Level = 1 Zoom to calling program ?", and on pressing Y(for Yes) Animator shows the message "Perform Level 1", and doesn't proceed to the the next line in the calling program (i.e, MAIN.COB) .
The only option available then is to Zoom all along which is not helping much during debugging.
Is there a runtime Switch or a Compiler option to make animator pass the control back to the calling program
Example:
This is the main program that iam debugging
IDENTIFICATION DIVISION.
PROGRAM-ID. MAIN.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-STUDENT-ID PIC 9(4) VALUE 1000.
01 WS-STUDENT-NAME PIC A(15) VALUE 'Tim'.
PROCEDURE DIVISION.
CALL 'UTIL' USING WS-STUDENT-ID, WS-STUDENT-NAME.
DISPLAY 'Student Id : ' WS-STUDENT-ID
DISPLAY 'Student Name : ' WS-STUDENT-NAME
STOP RUN.
This is the called program, UTIL,
IDENTIFICATION DIVISION.
PROGRAM-ID. UTIL.
DATA DIVISION.
LINKAGE SECTION.
01 LS-STUDENT-ID PIC 9(4).
01 LS-STUDENT-NAME PIC A(15).
PROCEDURE DIVISION USING LS-STUDENT-ID, LS-STUDENT-NAME.
DISPLAY 'In Called Program'.
MOVE 1111 TO LS-STUDENT-ID.
EXIT PROGRAM.
So when iam debugging MAIN program, and pass control to UTIL subroutine (by Perform and Step ). when i try to return back to calling program MAIN, animator gives the message "Perform Level = 1 Zoom to calling program ? Y/N" - when i press Y is shows a message at lower left saying ""Perform Level = 1" and doesnt skip to the program MAIN
When we look at the Perform / Call stack ( by pressing P and V ) animator displays the below Stack view
Perform/Call Stack View-----------------------------------
Program Name Section Name
----------------------------------------------------------
UTIL.int No Section or Paragraph
---------------------------------------------------------
Zoon Scroll <so on... >
---------------------------------------------------------
As you can see, only the Sub module is visible in the stack. Whereas it should have been.
Perform/Call Stack View-----------------------------------
Program Name Section Name
----------------------------------------------------------
UTIL.int No Section or Paragraph
MAIN.int No Section or Paragraph
---------------------------------------------------------
Zoon Scroll <so on... >
---------------------------------------------------------
(i.e., The calling point from the MAIN.int should also be visible)
This is why i suspect it has something to do with some missing compilation option or Environment settings

Dynamic memory allocation in COBOL

I have a common C function that I want to call from C, Fortran and COBOL. It fetches x bytes of data from a database and places it in a char pointer supplied to it. My example below fetches 1024 bytes, but in the real situation I want to be able to fetch much larger chunks of data than 1024 bytes as well, hence the dynamic memory allocation.
void fetch_data(char *fetched)
{
static struct {unsigned long data_length; char some_data[1024];} a_struct;
// Fetch data into a_struct.
memcpy(fetched, &(a_struct.some_data), 1024);
}
I was able to call this function successfully from C.
char *mydata;
mydata = malloc(1024);
fetch_data(mydata);
// Do something with the data.
free(mydata);
I was also able to call this function successfully from Fortran.
INTEGER*4, ALLOCATABLE :: MYDATA(:)
ALLOCATE(MYDATA(1024))
CALL FETCH_DATA(MYDATA)
// Do something with the data.
DEALLOCATE(MYDATA)
But how do I allocate and deallocate dynamic memory in COBOL? I have been unable to find built-in functions/procedures for this purpose.
I also don't see an alternative where C could handle the allocation and deallocation for Fortran and COBOL, as they need to access the data outside C.
As you've only talked about "COBOL" without specifying any actual implementation I assume you mean "standard COBOL".
This could mean COBOL85 - which doesn't have this feature but allows you to just define DATA-FOR-C PIC X(1024) and pass this as reference (COBOL85 actually doesn't specify anything about calling into C space but this should work with most if not all COBOL implementations). Note: This is actually more a detail of Acorns answer.
If you want to use real dynamic memory allocation and you mean standard COBOL - no problem with COBOL 2002 as it introduced the statements ALLOCATE and FREE (Note: this is actually the detail of the comments from roygvib and Rick):
77 pointer-variable USAGE POINTER.
77 address-holder PIC X BASED.
ALLOCATE variable-number CHARACTERS RETURNING pointer-variable
SET ADDRESS OF address-holder TO pointer-variable
CALL "fetch_data" USING address-holder
PERFORM stuff
FREE pointer-variable
If you don't use a COBOL implementation that support these statements you'd have to use the implementor specific routines (normally via CALL) to get/release the memory.
MicroFocus/NetCOBOL (see answer of Rick): CBL_ALLOC_MEM/CBL_FREE_MEM[2]
ACUCOBOL: M$ALLOC/M$FREE
IBM: CEEGTST
any COBOL compiler and runtime that allows to directly call C functions (which may adds additional needs as specifying the appropriate CALL-CONVENTION for those): malloc/free
... see your implementor's manual ...
One example with a very old compiler (Micro Focus COBOL v3.2.50). Much of this is taken directly from the supplemental materials. And since I didn't have an equally old C compiler available, I included a COBOL program as a subtitute.
program-id. dynam.
data division.
working-storage section.
1 ptr pointer.
1 mem-size pic x(4) comp-5 value 1024.
1 flags pic x(4) comp-5 value 1.
1 status-code pic x(2) comp-5.
linkage section.
1 mem pic x(1024).
procedure division.
call "CBL_ALLOC_MEM" using ptr
by value mem-size flags
returning status-code
if status-code not = 0
display "memory allocation failed"
stop run
else
set address of mem to ptr
end-if
call "fetch_data" using mem
display mem
call "CBL_FREE_MEM" using mem
returning status-code
if status-code not = 0
display "memory deallocation failed"
stop run
else
set address of mem to null
end-if
stop run
.
end program dynam.
program-id. "fetch_data".
data division.
working-storage section.
1 some-struct pic x(1024) value all "abcd".
linkage section.
1 mem pic x(1024).
procedure division using mem.
move some-struct to mem
exit program
.
end program "fetch_data".
The display (trimmed) is:
abcdabcdabcdabcd...(for 1024 characters total)
Maybe that will be of some help.
If you do not need the entire data in memory, then consider working chunk-by-chunk: allocate fixed-size storage in COBOL, fetch a chunk into it using the C function, work with it and loop to continue with the next chunk. This way you can avoid allocating dynamic memory altogether.
If you are on Z or using Gnu Cobol you can simply call malloc():
CALL "malloc" USING BY VALUE MEM-SIZE
RETURNING MEM-PTR.
CALL "free" USING BY VALUE MEM-PTR.

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.

Data type in COBOL

I have written the following program, I am confused why when I compile the program I get an error saying that A-COL(1,1) is not a numeric value while displaying A-COL(1,1) gives me 1.
IDENTIFICATION DIVISION.
PROGRAM-ID. TEST1.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 DIFF PIC 9(3).
01 ARRAY.
05 A-ROW OCCURS 99 TIMES.
10 A-COL OCCURS 2 TIMES.
15 TABLE-CONTENT PIC 9(3).
PROCEDURE DIVISION.
MOVE 1 TO A-COL(1,1).
MOVE 2 TO A-COL(2,1).
DISPLAY A-COL(1,1).
COMPUTE DIFF = A-COL(1,1) - A-COL(2,1).
DISPLAY DIFF.
STOP RUN.
Change the A-COL definition to
"10 A-COL PIC 9(3) OCCURS 2 TIMES."
and remove the TABLE-CONTENT.
Group variables are considered alphanumeric (X type) so cannot be used in a computation.
Alternatively you may do this - refer to the address location using the actual numeric field.
PROCEDURE DIVISION.
MOVE 1 TO TABLE-CONTENT(1,1).
MOVE 2 TO TABLE-CONTENT(2,1).
DISPLAY A-COL(1,1).
COMPUTE DIFF = TABLE-CONTENT(1,1) - TABLE-CONTENT(2,1).
DISPLAY DIFF.
Also you might want to make DIFF signed.
Additional Information
A-COL(1,1) displays "1" because it stores the data as "1xx" where x = space. That is not a numeric value. When you run the solutions here you will notice that display line produces "001".
Keep your WORKING-STORAGE structure the same. However, your data-elements are not A-COL, but THE-CONTENT. So use THE-CONTENT, not A-COL.
IDENTIFICATION DIVISION.
PROGRAM-ID. TEST1.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 DIFF PIC S9(3).
01 ARRAY.
05 A-ROW
OCCURS 99 TIMES.
10 A-COL
OCCURS 2 TIMES.
15 TABLE-CONTENT PIC 9(3).
PROCEDURE DIVISION.
MOVE 1 TO TABLE-CONTENT ( 1 1 )
MOVE 2 TO TABLE-CONTENT ( 2 1 )
DISPLAY
">"
TABLE-CONTENT ( 1 1 )
"<"
COMPUTE DIFF = TABLE-CONTENT ( 1 1 )
- TABLE-CONTENT ( 2 1 )
DISPLAY
">"
DIFF
"<"
STOP RUN
.
Your structure is better, because it is easier to maintain. If you ever want to REDEFINES TABLE-CONTENT, you can, without changing the structure. Not so if you "complicate" the structure now.
Yes, if you MOVE a numeric literal to a group-item, an alpha-numeric MOVE is carried out, the result will be your literal left-justified and space-padded to the right, or truncated to the right, or just fitting, depending on the size of your literal.
Although conceptually you have "columns" in your table (COBOL doesn't have arrays, it has tables with OCCURS), be aware that you cannot access a column as a whole. In storage you have row-1-col-1, row-1-col-2, row-2-col-1, row-2-col-2 through to row-99-col-1, row-99-col-2.
Any arithmetic (ADD, SUBTRACT, MULTIPLY, DIVIDE and COMPUTE) can only use numeric fields or literals as source-data. It is not enough that a field contains "a number", it must be a numeric field.
The GIVING (of ADD, SUBTRACT, MULTIPLY and DIVIDE) can place the result in a non-numeric field of a particular type, a numeric-edited field. This is a field with a PICture clause containing numeric-editing PICture symbols.

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

Resources