1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31 ^L
32
33
34
35 string: procedure;
36
37
38 dcl
39 Larg fixed bin (21),
40 Lmax fixed bin (21),
41 Lret fixed bin (21),
42 Nargs fixed bin,
43 Parg ptr,
44 Parg_list ptr,
45 Pret ptr,
46 code fixed bin (35),
47 i fixed bin;
48
49
50 dcl
51 arg char(Larg) based (Parg),
52
53 ret char(Lret) varying based (Pret);
54
55
56
57 dcl (addr, addrel, length, search) builtin;
58
59
60 dcl
61 cu_$af_return_arg entry (fixed bin, ptr, fixed bin (21), fixed bin(35)),
62 (cu_$af_arg_ptr,
63 cu_$arg_ptr) entry (fixed bin, ptr, fixed bin (21), fixed bin(35)),
64 cu_$arg_list_ptr entry (ptr),
65 cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr),
66 iox_$put_chars entry (ptr, ptr, fixed bin, fixed bin(35));
67
68
69 dcl
70 NL char(1) int static init ("
71 "),
72 SPACE char(1) int static init (" "),
73 iox_$user_output ptr ext static;
74 ^L
75
76
77
78 call cu_$af_return_arg (Nargs, Pret, Lret, code);
79 if code = 0 then do;
80 if Nargs = 0 then do;
81 ret = """""";
82 return;
83 end;
84 ret = """";
85 call cu_$af_arg_ptr (1, Parg, Larg, code);
86 if search (arg, """") > 0 then
87 ret = ret || double_quotes (arg);
88 else ret = ret || arg;
89 do i = 2 to Nargs;
90 ret = ret || " ";
91 call cu_$af_arg_ptr (i, Parg, Larg, code);
92 if search (arg, """") > 0 then
93 ret = ret || double_quotes (arg);
94 else ret = ret || arg;
95 end;
96 ret = ret || """";
97 end;
98 else do;
99 Lmax = 1;
100 do i = 1 to Nargs;
101 call cu_$arg_ptr (i, Parg, Larg, code);
102 Lmax = Lmax + Larg + 1;
103 end;
104
105 call cu_$arg_list_ptr (Parg_list);
106 begin;
107
108 dcl the_string char (Lmax) varying;
109 dcl i fixed bin;
110
111 the_string = "";
112 do i = 1 to Nargs;
113 call cu_$arg_ptr_rel (i, Parg, Larg, code, Parg_list);
114 if i ^= 1 then the_string = the_string || SPACE;
115 the_string = the_string || arg;
116 end;
117 the_string = the_string || NL;
118 call iox_$put_chars (iox_$user_output, addrel (addr (the_string), 1), length (the_string), code);
119 end;
120 end;
121 ^L
122 double_quotes: procedure (string) returns (char(*) varying);
123
124
125
126 dcl string char(*);
127
128 dcl (i, j) fixed bin;
129
130
131 dcl copied_string char(length(string)*2) varying;
132
133 dcl string_begin char(i-1) based (addr(string_array(j))),
134 string_end char(length(string)-(j-1)) based(addr(string_array(j))),
135 string_array (length(string)) char(1) based (addr(string));
136
137 i = search(string,"""");
138 if i = 0 then return(string);
139 j = 1;
140 copied_string = "";
141 do while (i > 0);
142 copied_string = copied_string || string_begin;
143 copied_string = copied_string || """""";
144 j = i+j;
145 i = search (string_end, """");
146 end;
147 copied_string = copied_string || string_end;
148 return (copied_string);
149
150
151 end double_quotes;
152
153
154 end string;