LIST can be specified on the last parameter in a parameter-descriptor list or as an attribute on the last parameter to a procedure.
|
When the LIST attribute is specified in an entry declaration, it indicates that zero or more additional arguments may be passed to that entry. For example, the following declare specifies that vararg must be invoked with one character varyingz parameter and may be invoked with any number of other parameters.
dcl vararg external
entry( list byaddr char(*) varz nonasgn )
options( nodescriptor byvalue );
When the LIST attribute is specified in the declaration of the last parameter in a procedure, it indicates that zero or more additional arguments may have been passed to that procedure.
When the LIST attribute is specified, no descriptors are allowed.
The address of the first of these additional parameters may be obtained via the VARGLIST built-in function. This address may be used to obtain the addresses of any additional parameters as follows:
The following sample program, which implements a simple version of printf, illustrates how to use the LIST attribute. The routine varg1 illustrates how to walk a variable argument list with byvalue parameters, while varg2 illustrates how to walk such a list with byaddr parameters.
*process rules(ans) dft(ans) gn;
*process langlvl(saa2);
vararg: proc options(main);
dcl i1 fixed bin(31) init(1729);
dcl i2 fixed bin(31) init(6);
dcl d1 float bin(53) init(17.29);
call varg1( 'test byvalue' );
call varg1( 'test1 parm1=%i', i1 );
call varg1( 'test2 parm1=%i parm2=%i', i1, i2 );
call varg1( 'test3 parm1=%d', d1 );
call varg2( 'test byaddr' );
call varg2( 'test1 parm1=%i', i1 );
call varg2( 'test2 parm1=%i parm2=%i', i1, i2 );
call varg2( 'test3 parm1=%d', d1 );
end;
*process ;
varg1:
proc( text )
options( nodescriptor byvalue );
dcl text list byaddr nonasgn varz char(*);
dcl jx fixed bin;
dcl iz fixed bin;
dcl ltext fixed bin;
dcl ptext pointer;
dcl p pointer;
dcl i fixed bin(31) based;
dcl d float bin(53) based;
dcl q float bin(64) based;
dcl chars char(32767) based;
dcl ch char(1) based;
ptext = addr(text);
ltext = length(text);
iz = index( substr(ptext->chars,1,ltext), '%' );
p = varglist();
do while( iz > 0 );
if iz = 1 then;
else
put edit( substr(ptext->chars,1,iz-1) )(a);
ptext += iz;
ltext -= iz;
select( ptext->ch );
when( 'i' )
do;
put edit( trim(p->i) )(a);
p += vargsize( p->i );
end;
when( 'd' )
do;
put edit( trim(p->d) )(a);
p += vargsize( p->d );
end;
end;
ptext += 1;
ltext -= 1;
if ltext <= 0 then leave;
iz = index( substr(ptext->chars,1,ltext), '%' );
end;
if ltext = 0 then;
else
put edit( substr(ptext->chars,1,ltext) )(a);
put skip;
end;
*process ;
varg2:
proc( text )
options( nodescriptor byaddr );
dcl text list byaddr nonasgn varz char(*);
dcl jx fixed bin;
dcl iz fixed bin;
dcl ltext fixed bin;
dcl ptext pointer;
dcl p pointer;
dcl p2 pointer based;
dcl i fixed bin(31) based;
dcl d float bin(53) based;
dcl q float bin(64) based;
dcl chars char(32767) based;
dcl ch char(1) based;
ptext = addr(text);
ltext = length(text);
iz = index( substr(ptext->chars,1,ltext), '%' );
p = varglist();
do while( iz > 0 );
if iz = 1 then;
else
put edit( substr(ptext->chars,1,iz-1) )(a);
ptext += iz;
ltext -= iz;
select( ptext->ch );
when( 'i' )
do;
put edit( trim(p->p2->i) )(a);
p += size( p );
end;
when( 'd' )
do;
put edit( trim(p->p2->d) )(a);
p += size( p );
end;
end;
ptext += 1;
ltext -= 1;
if ltext <= 0 then leave;
iz = index( substr(ptext->chars,1,ltext), '%' );
end;
if ltext = 0 then;
else
put edit( substr(ptext->chars,1,ltext) )(a);
put skip;
end;