1 copy_string:
 2 cps: proc();
 3 
 4   dcl  code fixed bin(35);
 5 
 6   dcl (active_fnc_err_,
 7        com_err_,
 8        complain variable
 9        )  entry options(variable);
10 
11   dcl  cu_$af_return_arg entry (fixed bin, ptr, fixed bin(21), fixed bin(35));
12   dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin(21), fixed bin(35));
13 
14   dcl (error_table_$bad_conversion,
15        error_table_$not_act_fnc,
16        error_table_$size_error,
17        error_table_$wrong_no_of_args
18        ) fixed bin(35) ext static;
19 
20   dcl (convert, copy, verify) builtin;
21   dcl  size condition;
22 
23 
24   dcl  argN fixed bin,
25        ret char(retML) var based(retP),
26        retML fixed bin(21),
27        retP ptr;
28 
29   dcl (F init("0"b),
30        T init("1"b)
31        ) bit(1) aligned int static options(constant);
32 
33   dcl  isAF bit(1) aligned init(T);
34 
35      complain = active_fnc_err_;
36      call cu_$af_return_arg( argN, retP, retML, code );
37      if  code = error_table_$not_act_fnc  then do;
38           isAF = F;
39           complain = com_err_;
40           end;
41      else if  code ^= 0  then goto ERROR;
42 
43      if  argN ^= 2  then do;
44           code = error_table_$wrong_no_of_args;
45 ERROR:    call complain( code, "copy_string", "Usage: ^[[^]cps STRING COUNT^[]^] ", isAF, isAF );
46           return;
47           end;
48 
49   dcl  str char(strL) based(strP),
50        strL fixed bin(21),
51        strP ptr;
52 
53      call cu_$arg_ptr( 1, strP, strL, code);
54 
55   dcl  cnt char(cntL) based(cntP),
56        cntL fixed bin(21),
57        cntP ptr;
58 
59      call cu_$arg_ptr( 2, cntP, cntL, code);
60 
61 
62   dcl  count fixed bin;
63 
64      on  size  begin;
65           code = error_table_$size_error;
66           goto BAD_COUNT;
67           end;
68 
69      if  verify( cnt, "+-0123456789" ) > 0  then do;
70           code = error_table_$bad_conversion;
71 BAD_COUNT:
72           call complain( code, "copy_string", "In COUNT: ^a", cnt );
73           return;
74           end;
75      count = convert( count, cnt );
76      if  count < 0  then do;
77           call complain( code, "copy_string", "COUNT may not be negative: ^a", cnt );
78           return;
79           end;
80 
81 
82   dcl  ioa_ entry() options(variable);
83      if  isAF  then
84           ret = copy(str, count);
85      else call ioa_( copy(str, count) );
86 
87      end copy_string;
88 
89