]>
Commit | Line | Data |
---|---|---|
1eee94d3 GM |
1 | (* varargs.mod provides a basic vararg facility for GNU Modula-2. |
2 | ||
83ffe9cd | 3 | Copyright (C) 2015-2023 Free Software Foundation, Inc. |
1eee94d3 GM |
4 | Contributed by Gaius Mulley <gaius@glam.ac.uk>. |
5 | ||
6 | This file is part of GNU Modula-2. | |
7 | ||
8 | GNU Modula-2 is free software; you can redistribute it and/or modify | |
9 | it under the terms of the GNU General Public License as published by | |
10 | the Free Software Foundation; either version 3, or (at your option) | |
11 | any later version. | |
12 | ||
13 | GNU Modula-2 is distributed in the hope that it will be useful, but | |
14 | WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
16 | General Public License for more details. | |
17 | ||
18 | You should have received a copy of the GNU General Public License | |
19 | along with GNU Modula-2; see the file COPYING3. If not see | |
20 | <http://www.gnu.org/licenses/>. *) | |
21 | ||
22 | IMPLEMENTATION MODULE varargs ; | |
23 | ||
24 | FROM Storage IMPORT ALLOCATE, DEALLOCATE ; | |
25 | FROM libc IMPORT memcpy ; | |
26 | FROM SYSTEM IMPORT ADDRESS, TSIZE, ADR, BYTE ; | |
27 | ||
28 | ||
29 | CONST | |
30 | MaxArg = 4 ; | |
31 | ||
32 | TYPE | |
33 | vararg = POINTER TO RECORD | |
34 | nArgs : CARDINAL ; | |
35 | i : CARDINAL ; | |
36 | contents: ADDRESS ; | |
37 | size : CARDINAL ; | |
38 | arg : ARRAY [0..MaxArg] OF argDesc ; | |
39 | END ; | |
40 | ||
41 | argDesc = RECORD | |
42 | ptr: ADDRESS ; | |
43 | len: CARDINAL ; | |
44 | END ; | |
45 | ||
46 | ptrToByte = POINTER TO BYTE ; | |
47 | ||
48 | ||
49 | (* | |
50 | arg - fills in, a, with the next argument. The size of, a, must be an exact | |
51 | match with the original vararg parameter. | |
52 | *) | |
53 | ||
54 | PROCEDURE arg (v: vararg; VAR a: ARRAY OF BYTE) ; | |
55 | VAR | |
56 | p: POINTER TO BYTE ; | |
57 | j: CARDINAL ; | |
58 | BEGIN | |
59 | WITH v^ DO | |
60 | IF i=nArgs | |
61 | THEN | |
62 | HALT (* too many calls to arg. *) | |
63 | ELSE | |
64 | IF HIGH(a)+1=arg[i].len | |
65 | THEN | |
66 | p := arg[i].ptr ; | |
67 | j := 0 ; | |
68 | WHILE j<=HIGH (a) DO | |
69 | a[j] := p^ ; | |
70 | INC (p) ; | |
71 | INC (j) | |
72 | END | |
73 | ELSE | |
74 | HALT (* parameter mismatch. *) | |
75 | END ; | |
76 | INC (i) | |
77 | END | |
78 | END | |
79 | END arg ; | |
80 | ||
81 | ||
82 | (* | |
83 | nargs - returns the number of arguments wrapped in, v. | |
84 | *) | |
85 | ||
86 | PROCEDURE nargs (v: vararg) : CARDINAL ; | |
87 | BEGIN | |
88 | RETURN v^.nArgs | |
89 | END nargs ; | |
90 | ||
91 | ||
92 | (* | |
93 | copy - returns a copy of, v. | |
94 | *) | |
95 | ||
96 | PROCEDURE copy (v: vararg) : vararg ; | |
97 | VAR | |
98 | c : vararg ; | |
99 | j, | |
100 | offset: CARDINAL ; | |
101 | BEGIN | |
102 | NEW (c) ; | |
103 | WITH c^ DO | |
104 | i := v^.i ; | |
105 | nArgs := v^.nArgs ; | |
106 | size := v^.size ; | |
107 | ALLOCATE (contents, size) ; | |
108 | contents := memcpy (contents, v^.contents, size) ; | |
109 | FOR j := 0 TO nArgs DO | |
110 | offset := VAL (CARDINAL, VAL (ptrToByte, v^.contents) - VAL (ptrToByte, v^.arg[j].ptr)) ; | |
111 | arg[j].ptr := VAL (ptrToByte, VAL (ptrToByte, contents) + offset) ; | |
112 | arg[j].len := v^.arg[j].len ; | |
113 | END | |
114 | END ; | |
115 | RETURN c | |
116 | END copy ; | |
117 | ||
118 | ||
119 | (* | |
120 | replace - fills the next argument with, a. The size of, a, | |
121 | must be an exact match with the original vararg | |
122 | parameter. | |
123 | *) | |
124 | ||
125 | PROCEDURE replace (v: vararg; VAR a: ARRAY OF BYTE) ; | |
126 | VAR | |
127 | p: POINTER TO BYTE ; | |
128 | j: CARDINAL ; | |
129 | BEGIN | |
130 | WITH v^ DO | |
131 | IF i=nArgs | |
132 | THEN | |
133 | HALT (* too many calls to arg. *) | |
134 | ELSE | |
135 | IF HIGH(a)+1=arg[i].len | |
136 | THEN | |
137 | p := arg[i].ptr ; | |
138 | j := 0 ; | |
139 | WHILE j<=HIGH (a) DO | |
140 | p^ := a[j] ; | |
141 | INC (p) ; | |
142 | INC (j) | |
143 | END | |
144 | ELSE | |
145 | HALT (* parameter mismatch. *) | |
146 | END | |
147 | END | |
148 | END | |
149 | END replace ; | |
150 | ||
151 | ||
152 | (* | |
153 | next - assigns the next arg to be collected as, i. | |
154 | *) | |
155 | ||
156 | PROCEDURE next (v: vararg; i: CARDINAL) ; | |
157 | BEGIN | |
158 | v^.i := i | |
159 | END next ; | |
160 | ||
161 | ||
162 | (* | |
163 | end - destructor for vararg, v. | |
164 | *) | |
165 | ||
166 | PROCEDURE end (VAR v: vararg) ; | |
167 | BEGIN | |
168 | IF v#NIL | |
169 | THEN | |
170 | DEALLOCATE (v^.contents, TSIZE (vararg)) ; | |
171 | DISPOSE (v) | |
172 | END | |
173 | END end ; | |
174 | ||
175 | ||
176 | (* | |
177 | start1 - wraps up argument, a, into a vararg. | |
178 | *) | |
179 | ||
180 | PROCEDURE start1 (a: ARRAY OF BYTE) : vararg ; | |
181 | VAR | |
182 | v: vararg ; | |
183 | BEGIN | |
184 | NEW (v) ; | |
185 | WITH v^ DO | |
186 | i := 0 ; | |
187 | nArgs := 1 ; | |
188 | size := HIGH (a) + 1; | |
189 | ALLOCATE (contents, size) ; | |
190 | contents := memcpy (contents, ADR (a), size) ; | |
191 | arg[0].ptr := contents ; | |
192 | arg[0].len := size | |
193 | END ; | |
194 | RETURN v | |
195 | END start1 ; | |
196 | ||
197 | ||
198 | (* | |
199 | start2 - wraps up arguments, a, b, into a vararg. | |
200 | *) | |
201 | ||
202 | PROCEDURE start2 (a, b: ARRAY OF BYTE) : vararg ; | |
203 | VAR | |
204 | v: vararg ; | |
205 | p: POINTER TO BYTE ; | |
206 | BEGIN | |
207 | NEW (v) ; | |
208 | WITH v^ DO | |
209 | i := 0 ; | |
210 | nArgs := 2 ; | |
211 | size := HIGH (a) + HIGH (b) + 2 ; | |
212 | ALLOCATE (contents, size) ; | |
213 | p := memcpy (contents, ADR (a), HIGH (a) + 1) ; | |
214 | arg[0].ptr := p ; | |
215 | arg[0].len := HIGH (a) + 1 ; | |
216 | INC (p, arg[0].len) ; | |
217 | p := memcpy (p, ADR (b), HIGH (b) + 1) ; | |
218 | arg[1].ptr := p ; | |
219 | arg[1].len := HIGH (b) + 1 | |
220 | END ; | |
221 | RETURN v | |
222 | END start2 ; | |
223 | ||
224 | ||
225 | (* | |
226 | start3 - wraps up arguments, a, b, c, into a vararg. | |
227 | *) | |
228 | ||
229 | PROCEDURE start3 (a, b, c: ARRAY OF BYTE) : vararg ; | |
230 | VAR | |
231 | v: vararg ; | |
232 | p: POINTER TO BYTE ; | |
233 | BEGIN | |
234 | NEW (v) ; | |
235 | WITH v^ DO | |
236 | i := 0 ; | |
237 | nArgs := 3 ; | |
238 | size := HIGH (a) + HIGH (b) + HIGH (c) + 3 ; | |
239 | ALLOCATE (contents, size) ; | |
240 | p := memcpy (contents, ADR (a), HIGH (a) + 1) ; | |
241 | arg[0].ptr := p ; | |
242 | arg[0].len := HIGH (a) + 1 ; | |
243 | INC (p, arg[0].len) ; | |
244 | p := memcpy (p, ADR (b), HIGH (b) + 1) ; | |
245 | arg[1].ptr := p ; | |
246 | arg[1].len := HIGH (b) + 1 ; | |
247 | INC (p, arg[1].len) ; | |
248 | p := memcpy (p, ADR (c), HIGH (c) + 1) ; | |
249 | arg[2].ptr := p ; | |
250 | arg[2].len := HIGH (c) + 1 | |
251 | END ; | |
252 | RETURN v | |
253 | END start3 ; | |
254 | ||
255 | ||
256 | (* | |
257 | start4 - wraps up arguments, a, b, c, d, into a vararg. | |
258 | *) | |
259 | ||
260 | PROCEDURE start4 (a, b, c, d: ARRAY OF BYTE) : vararg ; | |
261 | VAR | |
262 | v: vararg ; | |
263 | p: POINTER TO BYTE ; | |
264 | BEGIN | |
265 | NEW (v) ; | |
266 | WITH v^ DO | |
267 | i := 0 ; | |
268 | nArgs := 4 ; | |
269 | size := HIGH (a) + HIGH (b) + HIGH (c) + HIGH (d) + 4 ; | |
270 | ALLOCATE (contents, size) ; | |
271 | p := memcpy (contents, ADR (a), HIGH (a) + 1) ; | |
272 | arg[0].len := HIGH (a) + 1 ; | |
273 | INC (p, arg[0].len) ; | |
274 | p := memcpy (p, ADR (b), HIGH (b) + 1) ; | |
275 | arg[1].ptr := p ; | |
276 | arg[1].len := HIGH (b) + 1 ; | |
277 | INC (p, arg[1].len) ; | |
278 | p := memcpy (p, ADR (c), HIGH (c) + 1) ; | |
279 | arg[2].ptr := p ; | |
280 | arg[2].len := HIGH (c) + 1 ; | |
281 | INC (p, arg[2].len) ; | |
282 | p := memcpy (p, ADR (c), HIGH (c) + 1) ; | |
283 | arg[3].ptr := p ; | |
284 | arg[3].len := HIGH (c) + 1 | |
285 | END ; | |
286 | RETURN v | |
287 | END start4 ; | |
288 | ||
289 | ||
290 | END varargs. |