HP 3000 Manuals HP 3000 Manuals
CALL Prototypes
The following program demonstrates the use of CALL prototypes. Assume
that you have defined the following CALL prototype:
identification division.
program-id. callsub is external.
environment division.
configuration section.
special-names.
call-convention 3 in some-language.
data division.
linkage section.
01 x1 pic 9(4) comp-5.
01 x2 pic xx.
01 x3 pic 9(8).
01 x7 pic x.
procedure division some-language using by value x1
by reference x2
by reference x3.
entry "callsub2" using x2 delimited
any
x1.
entry "printf" using x7 delimited
any repeated.
end program callsub.
If you had the following "real" source coded in the same source file as
the previous CALL prototype:
identification division.
program-id. prog-1.
data division.
working-storage section.
01 x1 pic 9(4) comp-5.
01 x2.
05 pic 9(4) comp-5.
05 pic x(20).
01 x3 pic 9(8).
01 x4 pic 9(9) comp-5.
01 x5 pic x.
01 x6 pic x(20).
procedure division.
mainline.
call "callsub" using x1 x2 x3
the preceding CALL statement would be equivalent to using:
by value x1
by reference x2
by reference x3
The following examples show the results of different call statements:
Example 1
call "callsub" using x1 x2
The preceding CALL statement would generate an error since the number of
parameters is wrong.
Example 2
call other-language "callsub" using x1 x2 x3
The preceding CALL statement would generate an error since the
call-convention is wrong.
Example 3
call "callsub" using by reference x1 x2 x3
The preceding CALL statement would generate an error since x1 should be
passed by value.
Example 4
call "callsub" using 99 x2 x3
The preceding CALL statement would be equivalent to a call using:
by value 99 size 2
by reference x2
by reference x3
Example 5
call "callsub" using x4 x2 x3
The preceding CALL statement would generate an error since x4 has the
wrong length.
Example 6
call "callsub" using x1 x5 x3
The preceding CALL statement would generate an error since x5 is too
small.
Example 7
call "printf" using "A long %1\n" x4
In the preceding CALL statement x4 is a parameter covered by ANY
REPEATED.
Example 8
call "callsub2" using "Hello" x2 x1
The preceding CALL statement is equivalent to:
move "Hello" & x"00" to temp
call "callsub2" using temp x2 x1
Example 9
call "callsub2" using x6 x2 x1
The preceding CALL statement is equivalent to:
move x6 to temp
move x"00" to temp (21:1)
call "callsub2" using temp x2 x1
Example 10
call "callsub2" using x6 x2 x1 x4
The preceding CALL statement would generate an error as there are too
many parameters being passed.
Example of CALL Prototype Usage
If a COBOL application programmer wants to call a C function from within
his COBOL application the following need to be done:
* The C function parameters need to be defined within the COBOL
application. This means the mapping of C data types to COBOL data
types.
* The actual call to the C function must contain the correct number
of parameters and each parameter must be of the correct type.
* Any strings of text that need to passed to a C function will need
to be converted into a null terminated C string.
The use of COBOL TYPEDEFS and COBOL CALL prototypes may be used to
automate the above process. This includes the automatic conversion of
text strings into null terminated C strings. The following is an example
of how all this may be done.
Suppose I have a C function that I want to call. Let us call it
my_C_function. The following is a segment of C code that shows this
function:
sample.c
-----------------------------------------------------------------
/*** start of source module sample.c ***/
/*------------------------*/
/* Include Header Files */
/*------------------------*/
#include <stdio.h> #include "sample.h"
/*-------------------*/
/* Sample Function */
/*-------------------*/
int my_C_function (parm_1, parm_2, parm_3)
num_type parm_1;
unsigned char *parm_2;
complex_type *parm_3;
{
int rtn_code = 0;
printf(" my-C_function: invoked\n");
printf(" my-C_function: parm_1 = %d\n", parm_1);
if (parm_2 == NULL) {
printf(" my_C_function: parm_2 = IS NULL\n", parm_2);
rtn_code = -1;
} else {
printf(" my_C_function: parm_2 = %s\n", parm_2);
}
if (parm_3 == NULL ) {
printf(" my_C_function: parm_3 = IS NULL\n", parm_3);
rtn_code = -1;
} else {
printf(" my_C_function: parm_3\n");
printf(" (num1) = d\n", parm_3->num1);
printf(" (num2) = d\n", parm_3->num2);
}
printf(" my_C_function: completed\n");
return(rtn_code);
}
/*** end of source module sample.c ***/
-----------------------------------------------------------------
In this example we have three parameters for the C function:
* A typdef'ed value
* A C string
* A constructed data type
There is a header file that contains the C typedef definitions and also
the C function prototype. It is as follows:
sample.h
-----------------------------------------------------------------
/*** start of source module sample.h ***/
#ifndef SAMPLE
#define SAMPLE
/*------------*/
/* Typedefs */
/*------------*/
typedef int num_type;
typedef struct {
int num1;
long num2;
} complex_type;
/*----------------------/*
/* Function Prototype /*
/*----------------------/*
extern int my_C_function (
num_type parm_1,
unsigned char *parm_2,
complex_type *parm_3
);
#endif /* SAMPLE */
/*** end of source module sample.h ***/
-----------------------------------------------------------------
The first step is to convert the C typedefs and function prototypes into
COBOL TYPEDEFS and COBOL CALL prototypes. This may be done using the
h2cpy utility provided with Micro Focus COBOL.
h2cpy sample.h
produces the following copybook as output:
sample.cpy
-----------------------------------------------------------------
program-id. "c_typedefs" is external.
77 char pic s9(2) comp-5 is typedef.
77 uns-char pic 9(2) comp-5 is typedef.
77 short pic s9(4) comp-5 is typedef.
77 uns-short pic 9(4) comp-5 is typedef.
77 int pic s9(9) comp-5 is typedef.
77 uns-int pic 9(9) comp-5 is typedef.
77 long pic s9(9) comp-5 is typedef.
77 uns-long pic 9(9) comp-5 is typedef.
77 d-l-float comp-2 is typedef.
77 d-float comp-2 is typedef.
77 float comp-1 is typedef.
77 proc-pointer procedure-pointer is typedef.
77 data-pointer pointer is typedef.
77 void pic 9(2) comp-5 is typedef.
01 num-type is typedef usage int.
01 complex-type is typedef.
02 num1 usage int.
02 num2 usage long.
entry "my_C_function" using
by value int
by reference uns-char
by reference complex-type
returning int
.
end program "c-typedefs".
-----------------------------------------------------------------
In the above we have:
* Level 77's that map all the basic C data types to COBOL TYPEDEFS.
* Level 01's that are TYPEDEFS that match the C typedefs in the
header file
* An entry statement that acts as a COBOL CALL prototype for the C
function
The following changes should be made to this file with a text editor.
* Remove the level 77 data items that are not needed
* Change the uns-char mapping to map to "pic x" instead of a numeric
field. If this is not done then an attempt to pass a PIC X field
as a parameter would be rejected as not conforming to the
prototype parameter specification.
* Add the keyword
delimited
beside
uns-char
in the CALL prototype. This has the result of converting the TEXT
string passed as a parameter into a null terminated C string at
run time for the caller.
The result of the above editing is the following:
sample.cpy
-----------------------------------------------------------------
program-id. "c_typedefs" is external.
77 uns-char pic x is typedef.
77 int pic s9(9) comp-5 is typedef.
77 long pic s9(9) comp-5 is typedef.
77 data-pointer pointer is typedef.
01 num-type is typedef usage int.
01 complex-type is typedef.
02 num1 usage int.
02 num2 usage long.
entry "my_C_function" using
by value int
by reference uns-char delimited
by reference complex-type
returning int
.
end program "c_typedefs".
-----------------------------------------------------------------
The following is an example of the COBOL application that makes a call to
the my_C_function function.
-----------------------------------------------------------------
copy 'sample.cpy'.
identification division.
program-id. prog.
working-storage section.
01 ws-parm-1 usage num-type.
01 ws-parm-2 pic x(50)
value "This is a PIC X string from COBOL".
01 ws-parm-3 usage comlex-type.
01 ws-return-code usage int.
procedure division.
main-code section.
display "prog: started"
move 123 to ws-parm-1
move 1 to num1 IN ws-parm-3
move 2 to num2 IN ws-parm -3
display " "
display "prog: call 'my_C_function' with ALL parameters"
call "my_C_function" using ws-parm-1
ws-parm-2
ws-parm-3
returning ws-return-code
end-call
display "prog: 'my_C_function' return code = "
ws-return-code
display " "
display "prog: call 'my_C_function' with NULL parameters"
call "my_C_function" using 0
OMITTED
OMITTED
returning ws-return-code
end-call
display "prog: 'my_C_function' return code = "
ws-return-code
display " "
display "prog: completed"
exit program
stop run.
-----------------------------------------------------------------
In the above example the following has been coded:
* The copyfile sample.cpy has been included as the first statement
in the source. This is the copybook that contains the COBOL
TYPEDEFS and COBOL CALL prototypes.
Typedefs and prototypes are defined as complete "EXTERNAL"
programs. They are placed before real source programs in a
similar way to multi-program source files.
* The parameters for the C function have been defined in the
Working-Storage Section using the COBOL TYPEDEFS.
* In this example two calls are made to the C function. The
following should be noted from this:
* BY REFERENCE/VALUE has not been specified. The correct
default is picked up from the prototype.
* The prototype will ensure that the correct number of
parameters of the correct type has been specified. If not,
then the checker will flag an error at compile time.
* In the second call the special word OMITTED has been
specified to pass a BY REFERENCE parameter as a NULL
instead of a parameter value.
This is required because it is not possible to just go BY
VALUE 0 which would be flagged as invalid because BY
REFERENCE is mandatory for that parameter. OMITTED will
pass a NULL instead of a pointer to the parameter being
passed to the C function.
The following is the output that results when the specific example above
is run:
-----------------------------------------------------------------
%prog
prog: started
prog: call 'my_C_function' with ALL parameters
my_C_function: invoked
my_C_function: parm_1 = 123
my_C_function: parm_2 = This is a PIC X string from COBOL
my_C_function: parm_3
(num1) = 1
(num2) = 2
my_C_function: completed
prog: 'my_C_function' return code = +0000000000
prog: call 'my_C_function' with NULL parameters
my_C_function: invoked
my_C_function: parm_1 = 0
my_C_function: parm_2 = IS NULL
my_C_function: parm_3 = IS NULL
my_C_function: completed
prog: 'my_C_function' return code = +0000000001
prog: completed
%
-----------------------------------------------------------------
Calling and Setting a Procedure-Pointer
* Calling program:
program-id. startup.
working-storage section.
01 start-point usage procedure-pointer.
procedure-division.
set start-point to entry "menu"
call "controller" using start-point
display "End of run"
stop run.
entry "illegal"
* Recursive calls invalid without local-storage section.
stop run.
end program startup.
* Called program:
program-id. controller.
working-storage section.
01 next-option pic x.
linkage section.
01 current-proc usage procedure-pointer.
procedure division using current-proc.
perform until current-proc = NULL
call current-proc returning next-option
* Note program-id must be called before any entry point
evaluate next-option
when "a" set current-proc to entry "sub1"
when other set current-proc to NULL
end evaluate
end-perform
exit program.
end program controller.
program-id. menu.
working-storage section.
01 exit-option pic x.
procedure division.
display "In menu"
move "a" to exit-option
exit program returning exit-option.
* Note that the maximum size of returned value is 4 bytes
entry "sub1"
display "In sub1"
exit program returning 1.
Call Returning a Dynamically Allocated Data Area from a Subprogram
* Calling program:
program-id. calling.
working-storage section.
01 call-size pic x(4) comp-5 value 64.
linkage section.
01 call-area pic x.
procedure division.
call "sub2" using call-size
returning address of call-area
if address of call-area not = null
display "Contents of new area: " call-area(1:call-size)
end-if
stop run.
end program calling.
* Called program:
program-id. sub2.
working-storage section.
01 sub-pointer usage pointer.
linkage section.
01 link-size pic x(4) comp-5.
01 link-area pic x.
procedure division using link-size.
call "CBL_ALLOC_MEM" using sub-pointer
by value link-size
0 size is 4
if return-code = 0
set address of link-area to sub-pointer
move "Hello!" to link-area(1:call-size)
else set sub-pointer to null
end-if
exit program returning sub-pointer.
COPY (ANSI'68 or LANGLVL(1) Variation)
The COPY statement's behavior is slightly modified when the OLDCOPY
directive is set. This modification changes it from acting as defined by
the ANSI'74 and ANSI'85 standards to behaving as the old ANSI'68 standard
defined. This modified behavior is also consistent with how OS/VS COBOL
and DOS/VS COBOL behave when the LANGLVL(1) compiler option is used on an
IBM mainframe.
When the OLDCOPY directive is set and a copy member is intended to
include an entire 01 level data description, both the COPY statement and
the copied description should be defined with an 01 level item. However,
only the data name from the copying statement will be available to the
rest of the COBOL program. For example:
Source-file Code.
01 PRODUCT-CODE COPY COPYPROD.
Copy-file Code "COPYPROD":
01 PROD-CD.
05 ITEM-NAME PIC X(30).
05 ITEM-NUMBER PIC X(5).
Resulting COBOL Code:
01 PRODUCT-CODE.
05 ITEM-NAME PIC X(30).
05 ITEM-NUMBER PIC X(5).
COPY (Partial Word Replacement)
The COPY statement in an ANSI'85 conforming compiler can be used to
modify parts of words in the copy member source. It should be carefully
noted that this syntax only works when certain conventions (and special
characters) are used. When using this technique, the programmer must set
up their copy members with the modifiable sections pre-established. In
fact, once this technique is used, the copy members will NOT compile
cleanly when not replaced. For example:
Source-file Code:
copy Payroll
replacing ==(TAG)== by ==Payroll==.
Copy-file Code:
01 (TAG).
05 (TAG)-Week pic s99.
05 (TAG)-Gross-Paypic s9(5)v99.
05 (TAG)-Hours pic s9(3)
occurs 1 to 52 times
depending on (TAG)-Week of (TAG).
Is treated as if it were coded as:
01 Payroll.
05 Payroll-Week pic s99.
05 Payroll-Gross-Paypic s9(5)v99.
05 Payroll-Hours pic s9(3)
occurs 1 to 52 times
depending on Payroll-Week of Payroll.
CRT Status Clause of the SPECIAL-NAMES Paragraph
The CRT status clause of the SPECIAL-NAMES paragraph provides a data item
composed as follows:
* Status Key 1 - indicates the conditon that caused the termination
of the ACCEPT operation
* Status Key 2 - further distinguishes between ACCEPT termination
actions
* Status Key 3 - contains the raw keyboard code for the key that
terminated the ACCEPT operation.
The following examples show how the CRT status-key should be coded and
referenced.
************************************************************
* *
* The following shows how the special-names paragraph *
* sets up both a cursor position field and a CRT status *
* key field. *
* *
************************************************************
special names.
cursor is cursor-position
crt status is crt-status.
. . .
working-storage section.
01 cursor-position pic 9(4).
************************************************************
* The following group item defines the CRT status key *
* field and establishes certain 78-level condition-names *
* associated with key fields. *
* *
* Programs using these definitions should be compiled *
* with NOIBMCOMP and MF to function as expected. *
* *
************************************************************
01 crt-status.
05 crt-status-1 pic 9.
88 terminate-key value 0.
88 function-key value 1.
88 adis-key value 2.
88 status-1-error value 9.
05 crt-status-2 pic 99 comp-x.
88 esc-key value 0.
88 f1-key value 1.
88 enter-key value 1.
88 fun-key-num-user values 0 thru 127.
88 fun-key-num-system values 0 thru 26.
05 crt-status-3 pic 99 comp-x.
88 raw-key-code values 0 thru 255.
...
procedure-division.
...
************************************************************
* *
* The following shows the procedural code that would *
* evaluate the CRT status keys and direct processing *
* accordingly. *
* *
************************************************************
evaluate terminate-key also function-key also adis-key
when true also any also any
if esc-key
evaluate crt-status-3
when 0 perform raw-key-0
when 1 perform raw-key-1
when 2 perform raw-key-2
when 3 perform raw-key-3
...
end-evaluate
else
perform logic-for-terminator-key
end-if
when any also true also any
evaluate crt-status-2
when 1 perform user-function-1
when 2 perform user-function-2
when 3 perform user-function-3
when 4 perform user-function-4
when 5 perform user-function-5
...
end-evaluate
when any also any also true
evaluate crt-status-2
when 1 perform sys-function-1
when 2 perform sys-function-2
when 3 perform sys-function-3
when 4 perform sys-function-4
when 5 perform sys-function-5
...
end-evaluate
end-evaluate
$IF Statement (Conditional Compilation)
The $IF statement can be used to "conditionally compile" portions of your
source code. In the following example, if the program is compiled with
the directive,
CONSTANT WHERE "PC"
then at compile time, the word "NO" will be displayed and the object code
will include an EVALUATE rather than a GO TO statement.
$if WHERE = "PC"
evaluate test-field
when 5 perform test-a
end-evaluate
$if other-constant defined
$display Program compiled with other-constant set
$else
$display NO
$end
$else
go to test-a test-b depending on test-field
$end
INSPECT Statement (Tallying, Replacing, and Converting)
The INSPECT statement can be used to tally the number of occurrences of
specific character strings, to replace characters by other characters, or
to convert from one set of characters to another. Setting the conditons
for these inspections can be quite complex. The following examples
demonstrate some of the variations and uses of this verb.
In each of the following examples of the INSPECT statement, COUNT-n is
assumed to be zero immediately prior to execution of the statement. The
results shown for each example, except the last, are the result of
executing the two successive INSPECT statements shown above them.
Example 1:.
inspect item tallying
count-0 for all "AB", all "D"
count-1 for all "BC"
count-2 for leading "EF"
count-3 for leading "B"
count-4 for characters;
inspect item replacing
all "AB" by "XY", "D" by "X"
all "BC" by "VW"
leading "EF" by "TU"
leading "B" by "S"
first "G" by "R"
first "G" by "P"
characters by "Z"
---------------------------------------------------------------------------------------------------------
| | | | | | | |
| Intital Value of | COUNT-0 | COUNT-1 | COUNT-2 | COUNT-3 | COUNT-4 | Final Value of ITEM |
| ITEM | | | | | | |
| | | | | | | |
---------------------------------------------------------------------------------------------------------
| | | | | | | |
| EFABDBCGABEFGG | 3 | 1 | 1 | 0 | 5 | TUXYXVWRXYZZPZ |
| | | | | | | |
---------------------------------------------------------------------------------------------------------
| | | | | | | |
| BABABC | 2 | 0 | 0 | 1 | 1 | SXYXYZ |
| | | | | | | |
---------------------------------------------------------------------------------------------------------
| | | | | | | |
| BBBC | 0 | 1 | 0 | 2 | 0 | SSVW |
| | | | | | | |
---------------------------------------------------------------------------------------------------------
Example 2:.
inspect item tallying
count-0 for characters
count-1 for all "A";
inspect item replacing
characters by "Z"
all "A" by "X"
-------------------------------------------------------------------------------------------------
| | | | |
| Intital Value of ITEM | COUNT-0 | COUNT-1 | Final Value of ITEM |
| | | | |
-------------------------------------------------------------------------------------------------
| | | | |
| BBB | 3 | 0 | ZZZ |
| | | | |
-------------------------------------------------------------------------------------------------
| | | | |
| ABA | 3 | 0 | ZZZ |
| | | | |
-------------------------------------------------------------------------------------------------
Example 3:.
inspect item tallying
count-0 for all "AB" before "BC"
count-1 for leading "B" after "D"
count-2 for characters after "A" before "C"
inspect item replacing
all "AB" by "XY" before "BC"
leading "B" by "W" after "D"
first "E" by "V" after "D"
characters by "Z" after "A" before "C"
-----------------------------------------------------------------------------------------------------
| | | | | |
| Intital Value of | COUNT-0 | COUNT-1 | COUNT-2 | Final Value of |
| ITEM | | | | ITEM |
| | | | | |
-----------------------------------------------------------------------------------------------------
| | | | | |
| BBEABDABABBCABEE | 3 | 0 | 2 | BBEXUZXUXUZCABVE |
| | | | | |
-----------------------------------------------------------------------------------------------------
| | | | | |
| ADDDDC | 0 | 0 | 4 | AZZZZC |
| | | | | |
-----------------------------------------------------------------------------------------------------
| | | | | |
| ADDDDA | 0 | 0 | 5 | AZZZZZ |
| | | | | |
-----------------------------------------------------------------------------------------------------
| | | | | |
| CDDDDC | 0 | 0 | 0 | CDDDDC |
| | | | | |
-----------------------------------------------------------------------------------------------------
| | | | | |
| BDBBBDB | 0 | 3 | 0 | BDWWWDB |
| | | | | |
-----------------------------------------------------------------------------------------------------
Example 4:.
inspect item tallying
count-0 for all "AB" after "BA" before "BC";
inspect item replacing
all "AB" by "XY" after "BA" before "BC"
----------------------------------------------------------------------------------------------
| | | |
| Intital Value of ITEM | COUNT-0 | Final Value of ITEM |
| | | |
----------------------------------------------------------------------------------------------
| | | |
| ABABABABC | 1 | ABABXYABC |
| | | |
----------------------------------------------------------------------------------------------
Example 5:.
inspect item converting
"ABCD" to "XYZX" after quote before "#".
The above INSPECT is equivalent to the following INSPECT:
inspect item replacing
all "A" by "X" after quote before "#"
all "B" by "Y" after quote before "#"
all "C" by "Z" after quote before "#"
all "D" by "X" after quote before "#".
---------------------------------------------------------------------------------------------
| | |
| Intital Value of ITEM | Final Value of ITEM |
| | |
---------------------------------------------------------------------------------------------
| | |
| AC"AEBDFBCD#AB"D | AC"XEYXFYZX#AB"D |
| | |
---------------------------------------------------------------------------------------------
NEXT Clause of CONSTANT-NAMES
The NEXT clause of the constant-name format of a VALUE clause always
points to the offset at which the next byte of storage occurs after the
previous data declaration. For example, given the following:
01 x1 pic x(10).
01 x2 redefines x1 pic x.
78 next-offset value next.
01 x3 pic xx.
the value in next-offset will be the location of the second byte of x1
and not the starting location of x3.
This also can cause confusion with OCCURS clauses. For example, given
the following:
01 group-item.
05 tabl occurs 10 times.
78 offset-a value next.
10 elem pic x.
78 offset-b value next.
05 after-tabl pic x(02).
offset-a will point to the offset at the start of the first occurrence of
elem while offset-b will point to the starting location of the second
occurrence of table element elem and not to the starting location of
after-tabl. If you wanted to get the starting location of after-tabl,
you should recode your source as follows:
01 group-item.
05 dummy-item pic x(10).
78 offset-c value next.
05 tabl redefines dummy-item
occurs 10 times.
78 offset-a value next.
10 elem pic x.
78 offset-b value next.
05 after-tabl pic x (02).
In this example, offset-c will point to the starting offset of
after-tabl.
SORT Table Entries
A table sort using KEYS in OCCURS clause for sequencing:
working-storage section.
01 group-item.
05 tabl occurs 10 times
ascending elem-item2
descending elem-item1.
10 elem-item1 pic x.
10 elem-item2 pic x.
. . .
procedure division.
. . .
sort tabl.
if tabl (1) . . .
This is a simple sort in which the table is sorted in ascending order
using the key definitions in the OCCURS clause of data item Tabl to
determine the sequence, that is Elem-Item2 would be the major key
(ascending) and Elem-Item1 would be the secondary key (descending).
A table sort using the entire element for sequencing:
working-storage section.
01 group-item.
05 tabl occurs 10 times
10 elem-item1 pic x.
10 elem-item2 pic x.
. . .
procedure division.
. . .
sort tabl ascending.
if tabl (1) ...
This is a simple sort in which the table is sorted in ascending order
using each entire element of the table to determine the sequence.
A table sort with specified items for sequencing:
working-storage section.
01 group-item.
05 tabl occurs 10 times
ascending elem-item3
descending elem-item1.
10 elem-item1 pic x.
10 elem-item2 pic x.
10 elem-item3 pic x.
. . .
procedure division.
. . .
sort tabl descending elem-item2 elem-item3
if tabl (1) ...
This is a sort in which the table is sorted based on specified key data
items. The major key would be Elem-Item2, even though it was not
specified as a KEY in the OCCURS clause. The secondary key would be
Elem-Item3. It would be treated as a DESCENDING key for this sort
because the DESCENDING (which is transitive across KEY data items)
specified in the SORT statement would take precedence over the ASCENDING
specified in the OCCURS clause.
A table sort for a nested table:
working-storage section.
01 group-item.
05 tabl1 occurs 10 times
indexed by t1-ind t2-ind.
10 tabl2 occur 5 times.
15 group1.
20 elem-item1 pic x.
15 group2.
20 elem-item1 pic 9.
. . .
procedure division.
. . .
set t1-ind to 3
sort tabl2 descending elem-item1 of group2
if group1 (3 1) ...
This sorts only the third instance of Tabl2, that is Tabl2(3). It uses
the qualified data-item, Elem-Item1 of Group2 as its key. In normal
Procedure Division references, Elem-Item1 of Group2 would require two
levels of subscripting/indexing while in this reference it has none.
(Similarly, Tabl2 normally requires one level of subscripting, but cannot
be subscripted as data-name-2 in the SORT statement. Instead it uses the
value of T1-Ind for determining which instance is to be sorted.)
Split Key
If a program contained the following definition:
01 rec.
03 forename pic X(10).
03 personnel-no pic X(4).
03 surname pic X(15).
the syntax:
record key is fullname =
surname forename
would cause the COBOL system to treat
fullname
as though it were an explicitly defined group item consisting of:
03 surname pic X(15).
03 forename pic X(10).
TYPEDEF - User Defined USAGE or Structure
The compiler supports the following data descriptions:
01 struct-1 TYPEDEF.
05 part-1 pic x (20).
05 part-2 pic x(10).
01 USHORT pic 9 (4) comp-5 typedef.
which defines struct-1 and USHORT to be new usages that can be used as in
the following:
01 a.
05 b struct-1.
05 x USHORT.
which would be interpreted as if it had been coded as:
01 a.
05 b.
10 part-1 pic x(20).
10 part-2 pic x(10).
05 x pic 9(4) comp-5.