1 /*
2 * The Regina Rexx Interpreter
3 * Copyright (C) 1992-1994 Anders Christensen <anders@pvv.unit.no>
4 *
5 * This library is free software; you can redistribute it and/or
6 * modify it under the terms of the GNU Library General Public
7 * License as published by the Free Software Foundation; either
8 * version 2 of the License, or (at your option) any later version.
9 *
10 * This library is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 * Library General Public License for more details.
14 *
15 * You should have received a copy of the GNU Library General Public
16 * License along with this library; if not, write to the Free
17 * Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
18 */
19
20 /*
21 * Bug in LCC complier wchar.h that incorrectly says it defines stat struct
22 * but doesn't
23 */
24 #if defined(__LCC__)
25 # include <sys/stat.h>
26 #endif
27
28 #include "rexx.h"
29
30 #if defined(MAC)
31 # include "mac.h"
32 #else
33 # if defined(VMS)
34 # include <stat.h>
35 # else
36 # include <sys/stat.h>
37 # ifdef HAVE_UNISTD_H
38 # include <unistd.h>
39 # endif
40 # endif
41 #endif
42
43 #include <stdio.h>
44 #ifdef HAVE_ASSERT_H
45 # include <assert.h>
46 #endif
47
48 #if defined(__WATCOMC__) && !defined(__QNX__)
49 # include <dos.h>
50 #endif
51
52 #if defined(WIN32)
53 # ifdef _MSC_VER
54 # if _MSC_VER >= 1100
55 /* Stupid MSC can't compile own headers without warning at least in VC 5.0 */
56 # pragma warning(disable: 4115 4201 4214 4514)
57 # endif
58 # endif
59 # include <windows.h>
60 # ifdef _MSC_VER
61 # if _MSC_VER >= 1100
62 # pragma warning(default: 4115 4201 4214)
63 # endif
64 # endif
65 #endif
66
67 /*
68 * Since development of Ultrix has ceased, and they never managed to
69 * fix a few things, we want to define a few things, just in order
70 * to kill a few warnings ...
71 */
72 #if defined(FIX_PROTOS) && defined(FIX_ALL_PROTOS) && defined(ultrix)
73 int fstat( int fd, struct stat *buf ) ;
74 int stat( char *path, struct stat *buf ) ;
75 #endif
76
cms_sleep(tsd_t * TSD,cparamboxptr parms)77 streng *cms_sleep( tsd_t *TSD, cparamboxptr parms )
78 {
79 checkparam( parms, 1, 1, "SLEEP" ) ;
80 #if defined(WIN32) && (defined(_MSC_VER) || defined(__IBMC__) || defined(__BORLANDC__) || defined(__MINGW32__))
81 Sleep( (int)((myatof(TSD,parms->value))*1000) ) ;
82 #else
83 #if defined(HAVE_USLEEP)
84 usleep( (int)((myatof(TSD,parms->value))*1000*1000) ) ;
85 #else
86 sleep( atozpos( TSD, parms->value, "SLEEP", 1 ) ) ;
87 #endif
88 #endif
89 return nullstringptr() ;
90 }
91
92
cms_makebuf(tsd_t * TSD,cparamboxptr parms)93 streng *cms_makebuf( tsd_t *TSD, cparamboxptr parms )
94 {
95 checkparam( parms, 0, 0 , "MAKEBUF" ) ;
96 return int_to_streng( TSD,make_buffer( TSD )) ;
97 }
98
99
100
cms_justify(tsd_t * TSD,cparamboxptr parms)101 streng *cms_justify( tsd_t *TSD, cparamboxptr parms )
102 {
103 int inspace=0, i=0, count=0, between=0, extra=0, initial=0;
104 int spaces=0, chars=0, length=0 ;
105 char *cend=NULL, *cp=NULL, *cptr=NULL, *out=NULL, *oend=NULL ;
106 char pad=' ' ;
107 streng *result=NULL ;
108
109 checkparam( parms, 2, 3 , "JUSTIFY" ) ;
110
111 cptr = parms->value->value ;
112 cend = cptr + parms->value->len ;
113
114 length = atozpos( TSD, parms->next->value, "JUSTIFY", 2 ) ;
115 if (parms->next->next && parms->next->next->value)
116 pad = getonechar( TSD, parms->next->next->value, "JUSTIFY", 3 ) ;
117 else
118 pad = ' ' ;
119
120 inspace = 1 ;
121 spaces = 0 ;
122 chars = 0 ;
123 for (cp=cptr; cp<cend; cp++)
124 {
125 if (inspace)
126 {
127 if (!rx_isspace(*cp))
128 {
129 chars++ ;
130 inspace = 0 ;
131 }
132 }
133 else
134 {
135 if (!rx_isspace(*cp))
136 chars++ ;
137 else
138 {
139 spaces++ ;
140 inspace = 1 ;
141 }
142 }
143 }
144
145 if (inspace && spaces)
146 spaces-- ;
147
148 result = Str_makeTSD( length ) ;
149 if (chars+spaces>length || spaces==0)
150 {
151 between = 1 ;
152 extra = 0 ;
153 initial = 0 ;
154 }
155 else
156 {
157 extra = (length - chars) % spaces ;
158 between = (length - chars) / spaces ;
159 initial = (spaces - extra) / 2 ;
160 }
161
162 count = 0 ;
163 out = result->value ;
164 oend = out + length ;
165 cp = cptr ;
166 for (; cp<cend && rx_isspace(*cp); cp++) ;
167 for (; cp<cend && out<oend; cp++)
168 {
169 if (rx_isspace(*cp))
170 {
171 for (;cp<cend && rx_isspace(*cp); cp++) ;
172 for (i=0; i<between && out<oend; i++)
173 *(out++) = pad ;
174 if (count<initial)
175 count++ ;
176 else if (extra && out<oend)
177 {
178 extra-- ;
179 *(out++) = pad ;
180 }
181 if (out<oend)
182 *(out++) = *cp ;
183 }
184 else
185 *(out++) = *cp ;
186 }
187
188 for (; out<oend; out++)
189 *out = pad ;
190
191 assert( out - result->value == length ) ;
192 result->len = length ;
193
194 return result ;
195 }
196
197
198
cms_find(tsd_t * TSD,cparamboxptr parms)199 streng *cms_find( tsd_t *TSD, cparamboxptr parms )
200 {
201 parambox newparms[3];
202
203 checkparam( parms, 2, 3 , "FIND" ) ;
204
205 /* Rebuild parms but switch the first two parameters */
206
207 memset(newparms, 0, sizeof(newparms) ) ; /* sets dealloc to 0, too */
208 newparms[0].value = parms->next->value;
209 newparms[0].next = newparms + 1;
210 newparms[1].value = parms->value;
211 if (parms->next->next)
212 {
213 newparms[1].next = newparms + 2;
214 newparms[2].value = parms->next->next->value;
215 }
216
217 return std_wordpos( TSD, newparms ) ;
218 }
219
220
cms_index(tsd_t * TSD,cparamboxptr parms)221 streng *cms_index( tsd_t *TSD, cparamboxptr parms )
222 {
223 parambox newparms[3];
224
225 checkparam( parms, 2, 3 , "INDEX" ) ;
226
227 /* Rebuild parms but switch the first two parameters */
228
229 memset(newparms, 0, sizeof(newparms) ) ; /* sets dealloc to 0, too */
230 newparms[0].value = parms->next->value;
231 newparms[0].next = newparms + 1;
232 newparms[1].value = parms->value;
233 if (parms->next->next)
234 {
235 newparms[1].next = newparms + 2;
236 newparms[2].value = parms->next->next->value;
237 }
238
239 return std_pos( TSD, newparms ) ;
240 }
241
cms_desbuf(tsd_t * TSD,cparamboxptr parms)242 streng *cms_desbuf( tsd_t *TSD, cparamboxptr parms )
243 {
244 checkparam( parms, 0, 0 , "DESBUF" ) ;
245 return( int_to_streng( TSD,drop_buffer( TSD, 0))) ;
246 }
247
248
cms_buftype(tsd_t * TSD,cparamboxptr parms)249 streng *cms_buftype( tsd_t *TSD, cparamboxptr parms )
250 {
251 checkparam( parms, 0, 0 , "BUFTYPE" ) ;
252 type_buffer( TSD ) ;
253 return (nullstringptr()) ;
254 }
255
256
cms_dropbuf(tsd_t * TSD,cparamboxptr parms)257 streng *cms_dropbuf( tsd_t *TSD, cparamboxptr parms )
258 {
259 int buffer=(-1) ;
260
261 checkparam( parms, 0, 1 , "DROPBUF" ) ;
262 if (parms->value)
263 buffer = myatol(TSD, parms->value) ;
264
265 return( int_to_streng( TSD,drop_buffer(TSD, buffer))) ;
266 }
267
268
269 #ifdef HAS_SCANDIR
270 /* this part of the code is not used */
271
select_file(const struct direct * entry)272 static int select_file( const struct direct *entry )
273 {
274 return !(strcmp(entry->d_name,filename)) ;
275 }
276
277
cms_state(tsd_t * TSD,cparamboxptr parms)278 streng *cms_state( tsd_t *TSD, cparamboxptr parms )
279 {
280 struct direct *names=NULL ;
281 int last=0, result=0 ;
282 char *dir=NULL, *string=NULL, *retval=NULL ;
283
284 checkparam( parms, 1, 1 , "STATE" ) ;
285 last = strlen(string=parms->value) ;
286 for (;(string[last]!=FILE_SEPARATOR)&&(last>0);last--) ;
287 if (last)
288 {
289 string[last] = '\000' ;
290 dir = string ;
291 }
292 else
293 dir = "." ;
294
295 result = scandir(dir,&names,&select_file,NULL) ;
296 if (last)
297 string[last] = FILE_SEPARATOR ;
298
299 /* Ought to open or stat the file to check if it is readable */
300
301 return int_to_streng( TSD,result==1) ;
302 }
303 #else
304
305
cms_state(tsd_t * TSD,cparamboxptr parms)306 streng *cms_state( tsd_t *TSD, cparamboxptr parms )
307 {
308 /* this is a bit too easy ... but STREAM() function should handle it */
309 streng *retval=NULL ;
310 int rcode=0 ;
311 struct stat buffer ;
312 char *fn;
313
314 checkparam( parms, 1, 1 , "STATE" ) ;
315 retval = Str_makeTSD( BOOL_STR_LENGTH ) ;
316
317 /* will generate warning under Ultrix, don't care */
318 fn = str_of(TSD,parms->value);
319 rcode = stat( fn, &buffer ) ;
320 FreeTSD(fn);
321 return int_to_streng( TSD,rcode!=0) ;
322
323 }
324 #endif
325
326