"MIDRANGE-L" <midrange-l-bounces@xxxxxxxxxxxxxxxxxx> wrote on 03/01/2020
07:07:58 AM:
Err sorry. Yes. I should be passing in the bytes of 5 not precision of
9.
Let me see where that gets me.
OK, this is tested now. There is also a procedure for puting the
data back into the buffer. The following includes my test program --
which you should strip off and use just the procedures. But, the test
code does show you how you can call the procedures.
**free
ctl-opt main(dlctest) dftactgrp(*no);
dcl-ds buffer len(1024);
b_char char(50);
b_bigint int(20);
b_integer int(10);
b_packed packed(9:2);
b_smallint int(5);
b_varchar2 varchar(256);
b_varchar4 varchar(256:4);
b_zoned zoned(9:2);
end-ds;
dcl-s pos packed(5:0);
dcl-s r_result varchar(50);
dcl-proc dlctest;
// build the buffer
pos = 1;
PutBufferPiece( buffer: 'This is a character string test.'
: 'C': pos: %size(b_char) );
pos += %size(b_char);
PutBufferPiece( buffer: %char(-9223372036854775807)
: 'B': pos: %size(b_bigint) );
pos += %size(b_bigint);
PutBufferPiece( buffer: %char(-2147483647)
: 'I': pos: %size(b_integer) );
pos += %size(b_integer);
PutBufferPiece( buffer: %char(-1234567.89)
: 'P': pos: %size(b_packed): %decpos(b_packed) );
pos += %size(b_packed);
PutBufferPiece( buffer: %char(-32767)
: 'S': pos: %size(b_smallint) );
pos += %size(b_smallint);
PutBufferPiece( buffer: 'This is a variable-character2 string test.'
: 'V': pos: %size(b_varchar2) );
pos += %size(b_varchar2);
PutBufferPiece( buffer: 'This is a variable-character4 string test.'
: 'V': pos: %size(b_varchar4): 4 );
pos += %size(b_varchar4);
PutBufferPiece( buffer: '-1234567.89'
: 'Z': pos: %size(b_zoned): %decpos(b_zoned) );
// now test the buffer
pos = 1;
r_result = GetBufferPiece( buffer: 'C': pos
: %size(b_char) );
pos += %size(b_char);
r_result = GetBufferPiece( buffer: 'B': pos
: %size(b_bigint) );
pos += %size(b_bigint);
r_result = GetBufferPiece( buffer: 'I': pos
: %size(b_integer) );
pos += %size(b_integer);
r_result = GetBufferPiece( buffer: 'P': pos
: %size(b_packed): %decpos(b_packed) );
pos += %size(b_packed);
r_result = GetBufferPiece( buffer: 'S': pos
: %size(b_smallint) );
pos += %size(b_smallint);
r_result = GetBufferPiece( buffer: 'V': pos
: %size(b_varchar2): 2 );
pos += %size(b_varchar2);
r_result = GetBufferPiece( buffer: 'V': pos
: %size(b_varchar4): 4 );
pos += %size(b_varchar4);
r_result = GetBufferPiece( buffer: 'Z': pos
: %size(b_zoned): %decpos(b_zoned) );
return;
end-proc;
// This procedure will return a piece of a data buffer -- whether that
// piece is a character string, integer (binary numeric) data, packed
// numeric data, zoned numeric data, or variable-length character data.
// All types are returned as a variable length string with the numeric
// types converted from their buffer form to a (zoned) character string
// with leading sign. For data type, pass:
// C = character (default)
// B = big integer
// I = integer
// P = packed numeric
// S = small integer
// V = varchar (scale 4, or 2 by default)
// Z = zoned numeric
dcl-proc GetBufferPiece export;
dcl-pi *n varchar(256);
string_buffer char(65536) options(*varsize);
piece_type char(1) const;
beg_byte_pos packed(5:0) const;
max_byte_len packed(3:0) const;
max_scale packed(2:0) const options(*nopass);
end-pi;
dcl-ds char_area len(260);
varchar2_data varchar(256) pos(1);
varchar4_data varchar(256:4) pos(1);
packed_data packed(46:0) pos(1);
zoned_data zoned(46:0) pos(1);
bigint_data int(20) pos(1);
integer_data int(10) pos(1);
smallint_data int(5) pos(1);
end-ds;
dcl-c t_char 'C';
dcl-c t_bigint 'B';
dcl-c t_integer 'I';
dcl-c t_packed 'P';
dcl-c t_smallint 'S';
dcl-c t_varchar 'V';
dcl-c t_zoned 'Z';
dcl-s use_scale like(max_scale);
dcl-s d_shift packed(15:0);
dcl-s t_len packed(3:0);
dcl-s t_string varchar(50);
if %parms < %parmnum(max_scale)
or %addr(max_scale) = *null
or piece_type = t_varchar
and max_scale <> 4;
if piece_type = t_varchar;
use_scale = 2;
else;
use_scale = 0;
endif;
else;
use_scale = max_scale;
endif;
d_shift = %int(10 ** use_scale);
select;
when piece_type = t_bigint;
char_area = %subst(string_buffer:beg_byte_pos:max_byte_len);
return %char(bigint_data);
when piece_type = t_integer;
char_area = %subst(string_buffer:beg_byte_pos:max_byte_len);
return %char(integer_data);
when piece_type = t_packed;
packed_data = *zero;
%subst(char_area:%size(packed_data)-max_byte_len+1:max_byte_len)
= %subst(string_buffer:beg_byte_pos:max_byte_len);
t_string = %char(%dec(packed_data / d_shift));
t_len = %scan('.':t_string);
if t_len > *zero;
if use_scale > *zero;
t_string = %subst(t_string:1:t_len+use_scale);
else;
t_string = %subst(t_string:1:t_len-1);
endif;
endif;
return t_string;
when piece_type = t_smallint;
char_area = %subst(string_buffer:beg_byte_pos:max_byte_len);
return %char(smallint_data);
when piece_type = t_varchar and use_scale = 2;
char_area = %subst(string_buffer:beg_byte_pos:max_byte_len);
return varchar2_data;
when piece_type = t_varchar and use_scale = 4;
char_area = %subst(string_buffer:beg_byte_pos:max_byte_len);
return varchar4_data;
when piece_type = t_zoned;
zoned_data = *zero;
%subst(char_area:%size(zoned_data)-max_byte_len+1:max_byte_len)
= %subst(string_buffer:beg_byte_pos:max_byte_len);
t_string = %char(%dec(zoned_data / d_shift));
t_len = %scan('.':t_string);
if t_len > *zero;
if use_scale > *zero;
t_string = %subst(t_string:1:t_len+use_scale);
else;
t_string = %subst(t_string:1:t_len-1);
endif;
endif;
return t_string;
endsl;
char_area = %subst(string_buffer:beg_byte_pos:max_byte_len);
return %subst(char_area:1:max_byte_len);
end-proc;
// This procedure will update a piece of a data buffer -- whether that
// piece is a character string, integer (binary numeric) data, packed
// numeric data, zoned numeric data, or variable-length character data.
// For data type, pass:
// C = character (default)
// B = big integer
// I = integer
// P = packed numeric
// S = small integer
// V = varchar (scale 4, or 2 by default)
// Z = zoned numeric
dcl-proc PutBufferPiece export;
dcl-pi *n;
string_buffer char(65536) options(*varsize);
data_piece varchar(256) const;
piece_type char(1) const;
beg_byte_pos packed(5:0) const;
max_byte_len packed(3:0) const;
max_scale packed(2:0) const options(*nopass);
end-pi;
dcl-ds char_area len(260);
varchar2_data varchar(256) pos(1);
varchar4_data varchar(256:4) pos(1);
packed_data packed(46:0) pos(1);
zoned_data zoned(46:0) pos(1);
bigint_data int(20) pos(1);
integer_data int(10) pos(1);
smallint_data int(5) pos(1);
end-ds;
dcl-c t_char 'C';
dcl-c t_bigint 'B';
dcl-c t_integer 'I';
dcl-c t_packed 'P';
dcl-c t_smallint 'S';
dcl-c t_varchar 'V';
dcl-c t_zoned 'Z';
dcl-s use_scale like(max_scale);
dcl-s d_shift packed(15:0);
if %parms < %parmnum(max_scale)
or %addr(max_scale) = *null
or piece_type = t_varchar
and max_scale <> 4;
if piece_type = t_varchar;
use_scale = 2;
else;
use_scale = 0;
endif;
else;
use_scale = max_scale;
endif;
d_shift = %int(10 ** use_scale);
select;
when piece_type = t_bigint;
bigint_data = %int(%dec(data_piece:46:15) * d_shift);
%subst(string_buffer:beg_byte_pos:max_byte_len)
= %subst(char_area:1:max_byte_len);
when piece_type = t_integer;
integer_data = %int(%dec(data_piece:46:15) * d_shift);
%subst(string_buffer:beg_byte_pos:max_byte_len)
= %subst(char_area:1:max_byte_len);
when piece_type = t_packed;
packed_data = %int(%dec(data_piece:46:15) * d_shift);
%subst(string_buffer:beg_byte_pos:max_byte_len)
= %subst(char_area:%size(packed_data)-max_byte_len+1:max_byte_len
);
when piece_type = t_smallint;
smallint_data = %int(%dec(data_piece:46:15) * d_shift);
%subst(string_buffer:beg_byte_pos:max_byte_len)
= %subst(char_area:1:max_byte_len);
when piece_type = t_varchar and use_scale = 2;
varchar2_data = data_piece;
%subst(string_buffer:beg_byte_pos:max_byte_len)
= %subst(char_area:1:max_byte_len);
when piece_type = t_varchar and use_scale = 4;
varchar4_data = data_piece;
%subst(string_buffer:beg_byte_pos:max_byte_len)
= %subst(char_area:1:max_byte_len);
when piece_type = t_zoned;
zoned_data = %int(%dec(data_piece:46:15) * d_shift);
%subst(string_buffer:beg_byte_pos:max_byte_len)
= %subst(char_area:%size(zoned_data)-max_byte_len+1:max_byte_len);
other;
char_area = data_piece;
%subst(string_buffer:beg_byte_pos:max_byte_len)
= %subst(char_area:1:max_byte_len);
endsl;
return;
end-proc;
Sincerely,
Dave Clark
midrange.com
