1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18 Note
19
20
21
22
23 iod_command:
24 procedure () options (variable);
25
26
27 dcl argument character (argument_lth) unaligned based (argument_ptr);
28 dcl argument_lth fixed binary (21);
29 dcl argument_ptr pointer;
30
31 dcl system_area area based (system_area_ptr);
32 dcl system_area_ptr pointer;
33
34 dcl local_buffer character (512);
35
36 dcl buffer character (buffer_lth) based (buffer_ptr);
37 dcl buffer_lth fixed binary (21);
38 dcl buffer_ptr pointer;
39
40 dcl command_line character (command_line_lth) based (buffer_ptr);
41 dcl command_line_lth fixed binary (21);
42
43 dcl new_buffer character (new_buffer_lth) based (new_buffer_ptr);
44 dcl new_buffer_lth fixed binary (21);
45 dcl new_buffer_ptr pointer;
46
47 dcl (n_arguments, idx) fixed binary;
48
49 dcl code fixed binary (35);
50
51 dcl IOD_COMMAND character (32) static options (constant) initial ("iod_command");
52
53 dcl (MASTER initial (1),
54 RECURSIVE_COMMAND_LEVEL initial (2))
55 fixed binary static options (constant);
56
57 dcl (com_err_, com_err_$suppress_name) entry () options (variable);
58 dcl cu_$arg_count entry (fixed binary, fixed binary (35));
59 dcl cu_$arg_ptr entry (fixed binary, pointer, fixed binary (21), fixed binary (35));
60 dcl get_system_free_area_ entry () returns (pointer);
61 dcl iodd_command_processor_ entry (fixed binary, fixed binary, character (*), fixed binary (35));
62
63 dcl cleanup condition;
64
65 dcl (addr, length, max, substr) builtin;
66
67
68
69
70
71 call cu_$arg_count (n_arguments, code);
72 if code ^= 0 then do;
73 call com_err_ (code, IOD_COMMAND);
74 return;
75 end;
76
77 if n_arguments = 0 then do;
78 call com_err_$suppress_name (0, IOD_COMMAND, "Usage: ^a command_line", IOD_COMMAND);
79 return;
80 end;
81
82 command_line_lth = 0;
83
84 buffer_ptr = addr (local_buffer);
85 buffer_lth = length (local_buffer);
86
87 system_area_ptr = get_system_free_area_ ();
88
89 on condition (cleanup)
90 begin;
91 if buffer_ptr ^= addr (local_buffer) then
92 free buffer in (system_area);
93 end;
94
95
96
97
98
99 do idx = 1 to n_arguments;
100
101 call cu_$arg_ptr (idx, argument_ptr, argument_lth, code);
102 if code ^= 0 then do;
103 call com_err_ (code, IOD_COMMAND, "Fetching argument #^d.", idx);
104 go to RETURN_FROM_IOD_COMMAND;
105 end;
106
107 if (command_line_lth + argument_lth + 1) > buffer_lth
108 then do;
109 new_buffer_lth = max ((buffer_lth + 512), (command_line_lth + argument_lth + 128));
110 allocate new_buffer in (system_area) set (new_buffer_ptr);
111 new_buffer = buffer;
112 if buffer_ptr ^= addr (local_buffer) then
113 free buffer in (system_area);
114 buffer_ptr = new_buffer_ptr;
115 buffer_lth = new_buffer_lth;
116 end;
117
118 substr (buffer, (command_line_lth+1), (argument_lth+1)) = argument;
119
120 command_line_lth = command_line_lth + argument_lth + 1;
121 end;
122
123 command_line_lth = command_line_lth - 1;
124
125
126
127
128 call iodd_command_processor_ (MASTER, RECURSIVE_COMMAND_LEVEL, command_line, (0));
129
130
131
132
133 RETURN_FROM_IOD_COMMAND:
134 if buffer_ptr ^= addr (local_buffer) then
135 free buffer in (system_area);
136
137 return;
138
139 end iod_command;