LIST は、パラメーター記述子リストの最後のパラメーターで指定できます。または、プロシージャーへの最後のパラメーターの属性として指定できます。
|
LIST 属性が入り口宣言で指定された場合、 それは、ゼロまたはさらに追加の引数がそのエントリー・ポイントに渡される可能性があることを示します。 例えば、次の宣言では、 vararg が 1 文字の varyingz パラメーターを指定して 呼び出されなければならないこと、 および任意の数のほかのパラメーターを指定して 呼び出されなければならないことを指定します。
dcl vararg external
entry( list byaddr char(*) varz nonasgn )
options( nodescriptor byvalue );
LIST 属性がプロシージャーの最後のパラメーターの宣言中で指定される場合、 それは、ゼロまたはさらに追加の引数がそのプロシージャーに 渡された可能性があることを示します。
LIST 属性が指定された場合、記述子は許可されません。
それらの追加パラメーターの中の最初のパラメーターのアドレスは、 VARGLIST 組み込み関数を介して取得できます。 以下のように、このアドレスは、追加パラメーターのアドレスを 取得するのに使用されることがあります。
以下の (printf の簡単なバージョンを実現する) サンプル・プログラムは、 LIST 属性の使用法を示します。 ルーチン varg1 は、byvalue パラメーターを持つ変数の引数リストを処理する方法を示します。ルーチン varg2 は、byaddr パラメーターを持つ変数の引数リストを処理する方法を示します。
*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;