An SQLCA is a structure or a collection of variables that is updated at the end of the execution of every SQL statement. A program that contains executable SQL statements must provide either an SQLCA structure or a standalone SQLCODE field.
In all host languages except REXX, the SQL INCLUDE statement can be used to provide the declaration of the SQLCA. A similar set of variables is used for this purpose in REXX (see the DB2 REXX SQL for VM/ESA Installation and Reference manual for details).
The name of the storage area must be SQLCA.
The name of the structure must be SQLCA. Every executable SQL statement must be within the scope of its declaration.
The name of the COMMON area for the INTEGER and SMALLINT variables of the SQLCA must be SQLCA1; the name of the COMMON area for the CHARACTER and VARCHAR variables must be SQLCA2.
The description of the SQLCA that is given by INCLUDE SQLCA is shown for each of the host languages.
SQLCA DS 0F SQLCAID DS CL8 SQLCABC DS F SQLCODE DS F SQLERRM DS H,CL70 SQLERRP DS CL8 SQLERRD DS 6F SQLWARN DS 0C SQLWARN0 DS C SQLWARN1 DS C SQLWARN2 DS C SQLWARN3 DS C SQLWARN4 DS C SQLWARN5 DS C SQLWARN6 DS C SQLWARN7 DS C SQLWARN8 DS C SQLWARN9 DS C SQLWARNA DS C SQLSTATE DS CL5
#ifndef SQLCODE struct sqlca { unsigned char sqlcaid[8]; long sqlcabc; long sqlcode; short sqlerrml; unsigned char sqlerrmc[70]; unsigned char sqlerrp[8]; long sqlerrd[6]; unsigned char sqlwarn[11]; unsigned char sqlstate[5]; }; #define SQLCODE sqlca.sqlcode #define SQLWARN0 sqlca.sqlwarn[0] #define SQLWARN1 sqlca.sqlwarn[1] #define SQLWARN2 sqlca.sqlwarn[2] #define SQLWARN3 sqlca.sqlwarn[3] #define SQLWARN4 sqlca.sqlwarn[4] #define SQLWARN5 sqlca.sqlwarn[5] #define SQLWARN6 sqlca.sqlwarn[6] #define SQLWARN7 sqlca.sqlwarn[7] #define SQLWARN8 sqlca.sqlwarn[8] #define SQLWARN9 sqlca.sqlwarn[9] #define SQLWARNA sqlca.sqlwarn[10] #define SQLSTATE sqlca.sqlstate #endif struct sqlca sqlca;
01 SQLCA. 05 SQLCAID PIC X(8). 05 SQLCABC PIC S9(9) COMPUTATIONAL. 05 SQLCODE PIC S9(9) COMPUTATIONAL. 05 SQLERRM. 49 SQLERRML PIC S9(4) COMPUTATIONAL. 49 SQLERRMC PIC X(70). 05 SQLERRP PIC X(8). 05 SQLERRD OCCURS 6 TIMES PIC S9(9) COMPUTATIONAL. 05 SQLWARN. 10 SQLWARN0 PIC X(1). 10 SQLWARN1 PIC X(1). 10 SQLWARN2 PIC X(1). 10 SQLWARN3 PIC X(1). 10 SQLWARN4 PIC X(1). 10 SQLWARN5 PIC X(1). 10 SQLWARN6 PIC X(1). 10 SQLWARN7 PIC X(1). 10 SQLWARN8 PIC X(1). 10 SQLWARN9 PIC X(1). 10 SQLWARNA PIC X(1). 05 SQLSTATE PIC X(5).
INTEGER*4 SQLCOD, * SQLERR(6), * SQLTXL*2 COMMON /SQLCA1/ SQLCOD,SQLERR,SQLTXL CHARACTER SQLERP*8, * SQLWRN(0:10), * SQLTXT*70 * SQLSTT*5 COMMON /SQLCA2/ SQLERP,SQLWRN,SQLTXT,SQLSTT
DCL 1 SQLCA, 2 SQLCAID CHAR(8), 2 SQLCABC BIN FIXED(31), 2 SQLCODE BIN FIXED(31), 2 SQLERRM CHAR(70) VAR, 2 SQLERRP CHAR(8), 2 SQLERRD(6) BIN FIXED(31), 2 SQLWARN, 3 SQLWARN0 CHAR(1), 3 SQLWARN1 CHAR(1), 3 SQLWARN2 CHAR(1), 3 SQLWARN3 CHAR(1), 3 SQLWARN4 CHAR(1), 3 SQLWARN5 CHAR(1), 3 SQLWARN6 CHAR(1), 3 SQLWARN7 CHAR(1), 3 SQLWARN8 CHAR(1), 3 SQLWARN9 CHAR(1), 3 SQLWARNA CHAR(1), 2 SQLSTATE CHAR(5);
An SQLDA is a structure or collection of variables that is required for execution of the SQL DESCRIBE statement, and may optionally be used by the OPEN, FETCH, EXECUTE, and PUT statements. An SQLDA communicates with dynamic and extended SQL; it can be used in a DESCRIBE statement, modified with the addresses of host variables, and then reused in a FETCH statement. The DB2 Server for VSE & VM Application Programming manual describes the use of an SQLDA.
The meaning of the information in an SQLDA depends on its use. In DESCRIBE and Extended DESCRIBE, an SQLDA provides information to an application program about a prepared statement. In EXECUTE, OPEN, PUT, and Extended EXECUTE, Extended OPEN, and Extended PUT an SQLDA provides information to the database manager about input host variables. In Extended EXECUTE, FETCH and Extended FETCH, an SQLDA provides output information.
SQLDAs are supported in all languages, however predefined declarations are only provided by Assembler, C, and PL/I. In these languages the SQL INCLUDE statement can be used to provide a SQLDA declaration. A similar set of variables is used for this purpose in REXX (see the DB2 REXX SQL for VM/ESA manual for details).
An SQLDA consists of four variables followed by an arbitrary number of occurrences of a sequence of five variables collectively named SQLVAR. In OPEN, FETCH, PUT, and EXECUTE, each occurrence of SQLVAR describes a host variable. In DESCRIBE, they describe columns of a result table.
Assembler or PL/I Name 2 | C Name 2 | Data Type | Usage in DESCRIBE and Extended DESCRIBE (set by the database manager except for SQLN) | Usage in EXECUTE, FETCH, OPEN, PUT, and extended dynamic statements of the same name (set by the user prior to executing the statement) | ||
---|---|---|---|---|---|---|
SQLDAID | sqldaid | CHAR(8) | An 'eye catcher' for storage dumps, containing 'SQLDA '. | For CCSID when the protocol is SQLDS, the sixth position of this field must be set to '+'; for example, 'SQLDA+ '1 (See SQLNAME in Table 21) Not used otherwise. | ||
SQLDABC | sqldabc | INTEGER | Length of the SQLDA, equal to SQLN*44+16. | Number of bytes of storage allocated for the SQLDA. Enough storage must be allocated to contain SQLN occurrences. SQLDABC must be set to a value greater than or equal to 16+SQLN*44. | ||
SQLN | sqln | SMALLINT | Unchanged by the database manager. Must be set to a value greater than or equal to zero before the DESCRIBE statement is processed. Indicates the total number of occurrences of SQLVAR. | Total number of occurrences of SQLVAR provided in the SQLDA. SQLN must be set to a value greater than or equal to zero. | ||
SQLD | sqld | SMALLINT | For a SELECT statement, the number of columns described by occurrences of
SQLVAR (or, if USING BOTH was specified on DESCRIBE, twice the number of
columns).
For a non-SELECT statement, 0. | The number of host variables described by occurrences of SQLVAR to be used in the SQLDA when executing this statement. SQLD must be set to a value greater than or equal to zero and less than or equal to SQLN. | ||
2: The field names are those present in an SQLCA obtained from an INCLUDE statement. |
Assembler or PL/I Name | C Name | Data Type | Usage in DESCRIBE and Extended DESCRIBE (set by the database manager except for SQLN) | Usage in EXECUTE, FETCH, OPEN, PUT, and extended dynamic statements of the same name (set by the user prior to executing the statement) | ||
---|---|---|---|---|---|---|
SQLTYPE | sqltype | SMALLINT | Indicates the data type of the column and whether it can contain nulls. For a description of the type codes, see Table 22. | Indicates the data type of the host variable and whether an indicator variable is provided. For a description of the type codes, see Table 22. | ||
SQLLEN | sqllen | SMALLINT | The length attribute of the column. For datetime columns, the length of the string representation of the values. See Table 22. | The length attribute of the host variable. See Table 22. | ||
SQLDATA | sqldata | pointer | For string columns, SQLDATA contains the CCSID of the column. For character string columns, SQLDATA can alternatively contain the value X'FFFF' indicating bit data. For datetime columns, the SQLDATA contains the CCSID of the string representation of the values. See Table 23 for more information. | A pointer to the storage area that either holds the parameter value (if SQLDA is used for input), or is to hold a select list result (if the SQLDA is used for output). For varying-length character strings, the actual data should be preceded by a halfword field that specifies the length of the character string. (The value should not include the length of the halfword.) The data must be aligned on a halfword boundary. | ||
SQLIND | sqlind | pointer | For character and datetime data, byte 1 of SQLIND is set as
follows:
This information is not available when using the DRDA protocol. | Contains the address of the indicator variable where applicable.
The indicator variable must be declared as a 15-bit integer.
For an Input SQLDA, the indicator should be set to 0 to indicate that the parameter value is not null and to a negative value to indicate that the parameter value is null. For an Output SQLDA, the database manager fills in the indicator using the following rules:
| ||
SQLNAME | sqlname | VARCHAR (30) | Contains the name or label associated with the column used in the select list of the DESCRIBE statement. For more information, see "SQLNAME" on page ***. | For character, datetime and graphic data, SQLNAME may be used to override
1 the default CCSID.
An override is indicated by the following:
The override itself is present in bytes 3 and 4 of the SQLNAME. See Table 23 for the relation between the character subtypes, the graphic data type, and the CCSID. Note that bytes 5 to 8 of the SQLNAME field are reserved by IBM for future use in override situations for character and graphic data. For all other data, SQLNAME is not used. | ||
| ||||||
|
The following table shows the values that may appear in the
SQLTYPE and SQLLEN fields of the SQLDA. In DESCRIBE, an even value of
SQLTYPE means the column does not allow nulls, and an odd value means the
column does allow nulls. In EXECUTE, FETCH, OPEN, and PUT, an even
value of SQLTYPE means no indicator variable is provided, and an odd value
means that SQLIND contains the address of an indicator variable.
Table 22. SQLTYPE and SQLLEN Values for DESCRIBE, EXECUTE, FETCH, OPEN, and PUT
For DESCRIBE | For EXECUTE, FETCH, OPEN, and PUT | |||
---|---|---|---|---|
SQLTYPE | COLUMN DATA TYPE | SQLLEN | HOST VARIABLE DATA TYPE | SQLLEN |
384/385 | date | 10 or length of LOCAL date format | fixed-length character string representation of a date | length attribute of the host variable |
388/389 | time 1 | 8 or length of LOCAL time format | fixed-length character string representation of a time | length attribute of the host variable |
392/393 | timestamp 1 | 26 | fixed-length character string representation of a timestamp | length attribute of the host variable |
448/449 | varying-length character string | length attribute of the column | varying-length character string | length attribute of the host variable |
452/453 | fixed-length character string | length attribute of the column | fixed-length character string | length attribute of the host variable |
456/457 | long varying-length character string | length attribute of the column | long varying-length character string | length attribute of the host variable |
460/461 | N/A | N/A | NUL-terminated character string | length attribute of the host variable |
464/465 | varying-length graphic string | length attribute of the column | varying-length graphic string | length attribute of the host variable |
468/469 | fixed-length graphic string | length attribute of the column | fixed-length graphic string | length attribute of the host variable |
472/473 | long varying-length graphic string | length attribute of the column | long varying-length graphic string | length attribute of the host variable |
480/481 | floating point | 4 for single precision, 8 for double precision | floating point | 4 for single precision, 8 for double precision |
484/485 | packed decimal | precision in byte 1; scale in byte 2 | packed decimal | precision in byte 1; scale in byte 2 |
488/489 | zoned decimal 2 | precision in byte 1; scale in byte 2 | zoned decimal 2 | precision in byte 1; scale in byte 2 |
496/497 | large integer | 4 | large integer | 4 |
500/501 | small integer | 2 | small integer | 2 |
504/505 | N/A | N/A | DISPLAY SIGN LEADING SEPARATE | precision in byte 1; scale in byte 2 |
|
The following table describes the SQLDATA field for the DESCRIBE statement
and the SQLNAME field for host variables.
Table 23. CCSID Values for SQLDATA and SQLNAME
Data Type | Subtype | Bytes 1 & 2 | Bytes 3 & 4 |
---|---|---|---|
Character | SBCS data | X'0000' | The CCSID value |
Character | mixed data | X'0000' | The CCSID value |
Datetime | SBCS data | X'0000' | The CCSID value |
Datetime | mixed data | X'0000' | The CCSID value |
Character | bit data | X'0000' | X'FFFF' |
Graphic | N/A | X'0000' | The CCSID value |
Any other data type | N/A | N/A | N/A |
The description of the SQLDA that is given by INCLUDE SQLDA is shown for assembler, PL/I and C. Though you can use an SQLDA in VS COBOL II, and FORTRAN, the INCLUDE statement does not provide the code; you must provide it, as shown in the DB2 Server for VSE & VM Application Programming manual.
SQLDA DSECT SQLDAID DS CL8 SQLDABC DS F SQLN DS H SQLD DS H SQLVAR DS 0F SQLVARN DSECT SQLTYPE DS H SQLLEN DS 0H SQLPRCSN DS CL1 SQLSCALE DS CL1 SQLDATA DS A SQLIND DS A SQLNAME DS H,CL30 &SYSECT CSECT
#ifndef SQLDASIZE struct sqlda { unsigned char sqldaid[8]; long sqldabc; short sqln; short sqld; struct sqlvar { short sqltype; short sqllen; unsigned char *sqldata; short *sqlind; struct sqlname { short length; char data[30]; } sqlname; } sqlvar[1]; }; #define SQLDASIZE(n) (sizeof(struct sqlda)+((n)-1)*sizeof(struct sqlvar)) #endif
Note: | SQLDA character array variables sqldaid and sqlname.data are not NUL-terminated. They cannot be directly used by C string manipulation functions. |
The SQLDA must not be declared within the SQL declare section.
Using the defined preprocessor function SQLDASIZE, your program can dynamically allocate an SQLDA of adequate size for use with each EXECUTE statement. For example, the code fragment below allocates an SQLDA adequate for five fields and uses it in an EXECUTE statement S3:
struct sqlda *sqlptr; sqlptr = (struct sqlda *)malloc(SQLDASIZE(5)); sqlptr->SQLN=5; /* Add code to set the rest of values and pointers in the SQLDA */ EXEC SQL EXECUTE S3 USING DESCRIPTOR *sqlptr;
Note: | The variable used to point to the SQLDA is not defined in a SQL declare section. Its context within an SQL statement (following INTO or USING DESCRIPTOR) is enough to identify it. |
You can use a similar technique to allocate an SQLDA for use with a DESCRIBE statement. The following program fragment illustrates the use of SQLDA with DESCRIBE for three fields and a 'prepared' statement S1:
struct sqlda *sqlptr; EXEC SQL DECLARE C1 CURSOR FOR S1; sqlptr = (struct sqlda *)malloc(SQLDASIZE(3)); sqlptr->sqln=5; EXEC SQL DESCRIBE S1 INTO *sqlptr; if (sqlptr->sqld > sqlptr->sqln) --get a bigger one Set sqldata and sqlind EXEC SQL OPEN C1; EXEC SQL FETCH C1 USING DESCRIPTOR *sqlptr;
There is no standard C to support packed decimal data. If data in packed decimal format is required, the SQLDA must be filled in with an SQLTYPE of 484 or 485, with the appropriate values for precision and scale in SQLLEN. The C program would then deal with the data in its packed format.
DCL 1 SQLDA BASED(SQLDAPTR), 2 SQLDAID CHAR(8), 2 SQLDABC BIN FIXED(31), 2 SQLN BIN FIXED(15), 2 SQLD BIN FIXED(15), 2 SQLVAR (SQLSIZE REFER(SQLN)), 3 SQLTYPE BIN FIXED(15), 3 SQLLEN BIN FIXED(15), 3 SQLDATA PTR, 3 SQLIND PTR, 3 SQLNAME CHAR(30) VAR; DCL SQLSIZE BIN FIXED(15); DCL SQLDAPTR PTR;
The SQLDA must not be declared within the SQL declare section.
In addition to the structure above, you should also declare an additional mapping for the same area. The SQLPRCSN and SQLSCALE fields of the second mapping are used when decimal data is used. An example of this mapping follows.
DCL 1 SQLDA BASED(SQLDAPTR), 2 SQLDAIDX CHAR(8), 2 SQLDABCX BIN FIXED(31), 2 SQLNX BIN FIXED(15), 2 SQLDX BIN FIXED(15), 2 SQLVARX(SQLSIZE REFER(SQLNX)), 3 SQLTYPEX BIN FIXED(15), 3 SQLPRCSN format 1 or format 2 3 SQLSCALE format 1 or format 2 3 SQLDATAX PTR, 3 SQLINDX PTR, 3 SQLNAMEX CHAR(30) VAR:
You can declare the SQLPRCSR and SQLSCALE fields in one of two formats:
Format 1
3 SQLPRCSN BIT(8), 3 SQLSCALE BIT(8),
The fields must be set by 8-bit strings. For example, for a precision of 5 and a scale of 2, the following assignments are required:
SQLDAPTR->SQLPRCSN = '00000101'B, SQLDAPTR->SQLSCALE = '00000010'B,
Format 2
3 SQLPRCSN CHAR(1), 3 SQLSCALE CHAR(1),
This format requires the declaration of additional variables. These are a CHAR(2) variable and a BASED FIXED BIN (15) variable for both precision and scale. For example:
DCL PRCSNC CHAR(2) DCL PRCSNN FIXED BIN(15) BASED (ADDR(PRCSNC)); DCL SCALEC CHAR(2); DCL SCALEN FIXED BIN(15) BASED (ADDR(SCALEC));
For a precision of 5 and a scale of 2, the following assignments are required:
PRCSNN = 5; SCALEN = 2;
The SQLDAX fields for a precision of 5 and a scale of 2 would be:
SQLDAPTR->SQLPRCSN = SUBSTR(PRCSNC,2,1); SQLDAPTR->SQLSCALE = SUBSTR(SCALEC,2,1);
This format, though more complex than Format 1, allows PL/I manipulation of the precision and scale fields. For example, the value of the SQLPRCSN field can be determined by simply reversing the substring operation above. That is:
SUBSTR(PRCSNC,2,1) = SQLDAPTR->SQLPRCSN;
Such an operation is not possible using Format 1.
Because the PL/I SQLDA is declared as a based structure, your program can dynamically allocate an SQLDA of adequate size with each EXECUTE statement. For example, the code fragment below allocates an SQLDA adequate for five fields and uses it to EXECUTE statement S3:
SQLSIZE=5; ALLOCATE SQLDA SET(SQLDAPTR); /*Add code to set values and pointers in the SQLDA*/ EXEC SQL EXECUTE S3 USING DESCRIPTOR SQLDA;
The statement SQLSIZE=5 determines the size of the SQLDA to be allocated by means of the PL/I REFER feature. The ALLOCATE statement allocates an SQLDA of the size desired, and sets SQLDAPTR to point to it. (Before an EXECUTE statement is issued using this SQLDA, your program must fill its contents.)
You can use a similar technique to allocate an SQLDA for use with a DESCRIBE statement. The following program fragment illustrates the use of SQLDA with DESCRIBE for three fields and a 'prepared' statement S1:
EXEC SQL DECLARE C1 CURSOR FOR S1; SQLSIZE=3; ALLOCATE SQLDA SET(SQLDAPTR); EXEC SQL DESCRIBE S1 INTO SQLDA; IF SQLID>SQLN THEN - get a bigger one; Set SQLDATA and SQLIND; EXEC SQL OPEN C1; EXEC SQL FETCH C1 USING DESCRIPTOR SQLDA;