1 /*
2 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3 %
4 % File: PXK:PSLEXTRAS.C
5 % Description: Miscellaneous support routines.
6 % Author: RAM, HP/FSD
7 % Created: 9-Mar-84
8 % Modified: 21-Mar-85 11:25:52
9 % Mode: Text
10 % Package:
11 % Status: Open Source: BSD License
12 %
13 % (c) Copyright 1983, Hewlett-Packard Company, see the file
14 % HP_disclaimer at the root of the PSL file tree
15 %
16 % Redistribution and use in source and binary forms, with or without
17 % modification, are permitted provided that the following conditions are met:
18 %
19 % * Redistributions of source code must retain the relevant copyright
20 % notice, this list of conditions and the following disclaimer.
21 % * Redistributions in binary form must reproduce the above copyright
22 % notice, this list of conditions and the following disclaimer in the
23 % documentation and/or other materials provided with the distribution.
24 %
25 % THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
26 % AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
27 % THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
28 % PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNERS OR
29 % CONTRIBUTORS
30 % BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
31 % CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
32 % SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
33 % INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
34 % CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
35 % ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
36 % POSSIBILITY OF SUCH DAMAGE.
37 %
38 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
39 %
40 % Revisions:
41 %
42 % 05-Apr-88 (Julian Padget)
43 % Reinstated alarm and ualarm (again)
44 % 29-May-87 (Leigh Stoller & Harold Carr)
45 % Added external_setenv and friends.
46 % 21-Mar-85 11:09:00 (Scott Marovich)
47 % Rewrite "timc()" to return time since 1st call, and never cream LISP tag.
48 % 21-Feb-85 09:02:49 (Vicki O'Day)
49 % Fixed bug in uxwritefloat - it was setting the length field of the printable
50 % string incorrectly.
51 % 18-Jul-84 11:14:24 (RAM)
52 % Added external_time. Put call to expand_file_name in external_stat,
53 % external_link, and external_unlink.
54 % 10-Jul-84 (Vicki O'Day)
55 % Added external_stat, external_link and external_unlink.
56 % 29-Jun-84 14:15:53 (RAM)
57 % Removed hp_quit (obsolete).
58 % 27-Jun-84 (Vicki O'Day)
59 % Added external_strlen and external_getenv.
60 %
61 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
62 */
63
64 #include <stdlib.h>
65 #include <stdio.h>
66 #include <string.h>
67 #include <unistd.h>
68 #include <sys/types.h>
69 #include <sys/stat.h>
70 #include <sys/times.h>
71
external_alarm(sec)72 unsigned long long external_alarm(sec)
73 unsigned long sec;
74 {
75 return alarm(sec);
76 }
77
external_ualarm(usec,repeat)78 long long external_ualarm(usec,repeat)
79 unsigned long usec,repeat;
80 {
81 return ualarm(usec,repeat);
82 }
83
84 char *expand_file_name(); /* from unix-io.c */
85 long time(), times(); /* from kernel */
86
87 /* Tag( external_time )
88 */
external_time(tloc)89 long external_time(tloc)
90 long *tloc;
91 {
92 return (time(tloc));
93 }
94
95 /* Tag( external_timc )
96 */
97 int
external_timc(buffer)98 external_timc(buffer)
99 struct tms *buffer;
100 {
101 return(times(buffer));
102 }
103
104 /* Tag( external_stat )
105 */
external_stat(path,buf)106 int external_stat(path, buf)
107 char *path;
108 struct stat *buf;
109 {
110 return stat(expand_file_name(path), buf);
111 }
112
113
external_mkdir(name,mode)114 int external_mkdir (name, mode)
115 int mode;
116 char * name;
117 { return mkdir (name, mode); }
118
external_rmdir(name)119 int external_rmdir (name)
120 char * name;
121 { return rmdir (name); }
122
123 /* Tag( external_link )
124 */
external_link(path1,path2)125 int external_link (path1, path2)
126 char *path1, *path2;
127 {
128 return link(expand_file_name(path1), expand_file_name(path2));
129 }
130
131 /* Tag( external_unlink )
132 */
external_unlink(path)133 int external_unlink (path)
134 char *path;
135 {
136 return unlink(expand_file_name(path));
137 }
138
139 /* Tag( external_strlen )
140 */
external_strlen(s)141 int external_strlen (s)
142 char *s;
143 {
144 return strlen(s);
145 }
146
147 /* Tag( external_getenv )
148 */
external_getenv(name)149 char *external_getenv (name)
150 char *name;
151 {
152 return (char *)getenv(name);
153 }
154
155
external_setenv(var,val,ov)156 int external_setenv (var, val, ov)
157 const char *var, *val;
158 int ov;
159 {
160 int i;
161 extern char **environ;
162 char **envnew;
163 char var_plus_equal_sign[100];
164
165 /* Look for first empty slot to find number of existing env variables. */
166 for (i = 0 ; environ [i] != NULL ; i++) ;
167
168 /* Make a new environment array with 2 new slots - 1 for var being set,
169 and 1 extra empty slot. */
170 envnew = (char **) calloc ((i + 2), sizeof(char *));
171
172 bcopy((char *)environ, (char *)envnew, i * sizeof(char *));
173 environ = envnew;
174 strcpy(var_plus_equal_sign, var);
175 strcat(var_plus_equal_sign, "=");
176 return(setenv (var_plus_equal_sign, val, ov));
177 }
178
179 /*
180 * sets the value of var to be arg in the Unix environment env.
181 * Var should end with '=' (bindings are of the form "var=value").
182 * This procedure assumes the memory for the first level of environ
183 * was allocated using calloc, with enough extra room at the end so not
184 * to have to do a realloc().
185 */
186 int
setenv(var,value,ov)187 setenv (var, value, ov)
188 const char *var, *value;
189 int ov;
190 {
191 extern char **environ;
192 int index = 0;
193 int len = strlen(var);
194
195 while (environ [index] != NULL) {
196 if (strncmp (environ [index], var, len) == 0) {
197 /* found it */
198 environ[index] = (char *)malloc (len + strlen (value) + 1);
199 strcpy (environ [index], var);
200 strcat (environ [index], value);
201 return ov;
202 }
203 index ++;
204 }
205
206 environ [index] = (char *) malloc (len + strlen (value) + 1);
207 strcpy (environ [index], var);
208 strcat (environ [index], value);
209 environ [++index] = NULL;
210 }
211
212 void
block_copy(b1,b2,length)213 block_copy (b1, b2, length)
214 char *b1, *b2;
215 int length;
216 {
217 while (length-- > 0)
218 *b2++ = *b1++;
219 }
220
221 #define LISPEOF 4 /* Lisp uses ctrl-D for end of file */
222
223 /* Tag( unixreadrecord )
224 */
unixreadrecord(fp,buf)225 int unixreadrecord(fp, buf)
226 FILE *fp;
227 char *buf;
228 {
229 int i;
230 char c;
231 for (i=0, c=' '; ((c != LISPEOF) && (c != '\n')); i++)
232 {
233 c = fgetc(fp);
234 if (c == EOF )
235 c = LISPEOF;
236 *buf++ = c;
237 }
238 return i;
239 }
240
241 /* Tag( unixwriterecord )
242 */
unixwriterecord(fp,buf,count)243 void unixwriterecord(fp, buf, count)
244 FILE *fp;
245 char *buf;
246 int count;
247 {
248 int i;
249 for (i=0; i<count; i++, buf++)
250 fputc(*buf, fp);
251 }
252
253
wquotient(long long x,long long y)254 int wquotient(long long x, long long y)
255 {
256 return (x / y);
257 }
258
wremainder(long long x,long long y)259 int wremainder(long long x, long long y)
260 {
261 return (x % y);
262 }
263
wxdivide(long long x,long long y,long long * rem)264 int wxdivide(long long x, long long y, long long * rem)
265 {
266 int q = x / y;
267 *rem = x - y * q;
268 return q;
269 }
270
wxquotientdouble(unsigned __int128 dividend,unsigned long long divisor,unsigned long long * rem)271 unsigned int wxquotientdouble(unsigned __int128 dividend,unsigned long long divisor,unsigned long long *rem)
272 {
273 unsigned long long int q = dividend / divisor;
274 *rem = dividend - divisor * q;
275 return q;
276 }
277
278
279
280