This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 1.0 patch 14: a2p incorrectly translates 'for (a in b)' construct.
[perl5.git] / util.c
CommitLineData
a559c259 1/* $Header: util.c,v 1.0.1.1 88/01/28 11:06:35 root Exp $
8d063cd8
LW
2 *
3 * $Log: util.c,v $
a559c259
LW
4 * Revision 1.0.1.1 88/01/28 11:06:35 root
5 * patch8: changed fatal() to support eval operator with exiting.
6 *
8d063cd8
LW
7 * Revision 1.0 87/12/18 13:06:30 root
8 * Initial revision
9 *
10 */
11
12#include <stdio.h>
13
14#include "handy.h"
15#include "EXTERN.h"
16#include "search.h"
17#include "perl.h"
18#include "INTERN.h"
19#include "util.h"
20
21#define FLUSH
22#define MEM_SIZE unsigned int
23
24static char nomem[] = "Out of memory!\n";
25
26/* paranoid version of malloc */
27
28static int an = 0;
29
30char *
31safemalloc(size)
32MEM_SIZE size;
33{
34 char *ptr;
35 char *malloc();
36
37 ptr = malloc(size?size:1); /* malloc(0) is NASTY on our system */
38#ifdef DEBUGGING
39 if (debug & 128)
40 fprintf(stderr,"0x%x: (%05d) malloc %d bytes\n",ptr,an++,size);
41#endif
42 if (ptr != Nullch)
43 return ptr;
44 else {
45 fputs(nomem,stdout) FLUSH;
46 exit(1);
47 }
48 /*NOTREACHED*/
49}
50
51/* paranoid version of realloc */
52
53char *
54saferealloc(where,size)
55char *where;
56MEM_SIZE size;
57{
58 char *ptr;
59 char *realloc();
60
61 ptr = realloc(where,size?size:1); /* realloc(0) is NASTY on our system */
62#ifdef DEBUGGING
63 if (debug & 128) {
64 fprintf(stderr,"0x%x: (%05d) rfree\n",where,an++);
65 fprintf(stderr,"0x%x: (%05d) realloc %d bytes\n",ptr,an++,size);
66 }
67#endif
68 if (ptr != Nullch)
69 return ptr;
70 else {
71 fputs(nomem,stdout) FLUSH;
72 exit(1);
73 }
74 /*NOTREACHED*/
75}
76
77/* safe version of free */
78
79safefree(where)
80char *where;
81{
82#ifdef DEBUGGING
83 if (debug & 128)
84 fprintf(stderr,"0x%x: (%05d) free\n",where,an++);
85#endif
86 free(where);
87}
88
89/* safe version of string copy */
90
91char *
92safecpy(to,from,len)
93char *to;
94register char *from;
95register int len;
96{
97 register char *dest = to;
98
99 if (from != Nullch)
100 for (len--; len && (*dest++ = *from++); len--) ;
101 *dest = '\0';
102 return to;
103}
104
105#ifdef undef
106/* safe version of string concatenate, with \n deletion and space padding */
107
108char *
109safecat(to,from,len)
110char *to;
111register char *from;
112register int len;
113{
114 register char *dest = to;
115
116 len--; /* leave room for null */
117 if (*dest) {
118 while (len && *dest++) len--;
119 if (len) {
120 len--;
121 *(dest-1) = ' ';
122 }
123 }
124 if (from != Nullch)
125 while (len && (*dest++ = *from++)) len--;
126 if (len)
127 dest--;
128 if (*(dest-1) == '\n')
129 dest--;
130 *dest = '\0';
131 return to;
132}
133#endif
134
135/* copy a string up to some (non-backslashed) delimiter, if any */
136
137char *
138cpytill(to,from,delim)
139register char *to, *from;
140register int delim;
141{
142 for (; *from; from++,to++) {
143 if (*from == '\\' && from[1] == delim)
144 from++;
145 else if (*from == delim)
146 break;
147 *to = *from;
148 }
149 *to = '\0';
150 return from;
151}
152
153/* return ptr to little string in big string, NULL if not found */
154
155char *
156instr(big, little)
157char *big, *little;
158
159{
160 register char *t, *s, *x;
161
162 for (t = big; *t; t++) {
163 for (x=t,s=little; *s; x++,s++) {
164 if (!*x)
165 return Nullch;
166 if (*s != *x)
167 break;
168 }
169 if (!*s)
170 return t;
171 }
172 return Nullch;
173}
174
175/* copy a string to a safe spot */
176
177char *
178savestr(str)
179char *str;
180{
181 register char *newaddr = safemalloc((MEM_SIZE)(strlen(str)+1));
182
183 (void)strcpy(newaddr,str);
184 return newaddr;
185}
186
187/* grow a static string to at least a certain length */
188
189void
190growstr(strptr,curlen,newlen)
191char **strptr;
192int *curlen;
193int newlen;
194{
195 if (newlen > *curlen) { /* need more room? */
196 if (*curlen)
197 *strptr = saferealloc(*strptr,(MEM_SIZE)newlen);
198 else
199 *strptr = safemalloc((MEM_SIZE)newlen);
200 *curlen = newlen;
201 }
202}
203
204/*VARARGS1*/
205fatal(pat,a1,a2,a3,a4)
206char *pat;
207{
208 extern FILE *e_fp;
209 extern char *e_tmpname;
210
a559c259
LW
211 if (in_eval) {
212 sprintf(tokenbuf,pat,a1,a2,a3,a4);
213 str_set(stabent("@",TRUE)->stab_val,tokenbuf);
214 longjmp(eval_env,1);
215 }
8d063cd8
LW
216 fprintf(stderr,pat,a1,a2,a3,a4);
217 if (e_fp)
218 UNLINK(e_tmpname);
219 exit(1);
220}
221
222static bool firstsetenv = TRUE;
223extern char **environ;
224
225void
226setenv(nam,val)
227char *nam, *val;
228{
229 register int i=envix(nam); /* where does it go? */
230
231 if (!environ[i]) { /* does not exist yet */
232 if (firstsetenv) { /* need we copy environment? */
233 int j;
234#ifndef lint
235 char **tmpenv = (char**) /* point our wand at memory */
236 safemalloc((i+2) * sizeof(char*));
237#else
238 char **tmpenv = Null(char **);
239#endif /* lint */
240
241 firstsetenv = FALSE;
242 for (j=0; j<i; j++) /* copy environment */
243 tmpenv[j] = environ[j];
244 environ = tmpenv; /* tell exec where it is now */
245 }
246#ifndef lint
247 else
248 environ = (char**) saferealloc((char*) environ,
249 (i+2) * sizeof(char*));
250 /* just expand it a bit */
251#endif /* lint */
252 environ[i+1] = Nullch; /* make sure it's null terminated */
253 }
254 environ[i] = safemalloc(strlen(nam) + strlen(val) + 2);
255 /* this may or may not be in */
256 /* the old environ structure */
257 sprintf(environ[i],"%s=%s",nam,val);/* all that work just for this */
258}
259
260int
261envix(nam)
262char *nam;
263{
264 register int i, len = strlen(nam);
265
266 for (i = 0; environ[i]; i++) {
267 if (strnEQ(environ[i],nam,len) && environ[i][len] == '=')
268 break; /* strnEQ must come first to avoid */
269 } /* potential SEGV's */
270 return i;
271}