This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
The LGPL code relicensed, with permission from Mark Klein of DIS.
[perl5.git] / mpeix / mpeix.c
CommitLineData
feb33499
JH
1
2/*
3 * gcc long pointer support code for HPPA.
4 * Copyright 1998, DIS International, Ltd.
c72515e3
JH
5 * This code is free software; you may redistribute it and/or modify
6 * it under the same terms as Perl itself. (Relicensed for Perl in
7 * in April 2002 by Mark Klein.)
feb33499
JH
8 */
9typedef struct {
10 int spaceid;
11 unsigned int offset;
12 } LONGPOINTER, longpointer;
13
14/*
15 * gcc long pointer support code for HPPA.
16 * Copyright 1998, DIS International, Ltd.
c72515e3
JH
17 * This code is free software; you may redistribute it and/or modify
18 * it under the same terms as Perl itself. (Relicensed for Perl in
19 * in April 2002 by Mark Klein.)
feb33499
JH
20 */
21
22int __perl_mpe_getspaceid(void *source)
23 {
24 int val;
25 /*
26 * Given the short pointer, determine it's space ID.
27 */
28
29 /*
30 * The colons separate output from input parameters. In this case,
31 * the output of the instruction (output indicated by the "=" in the
32 * constraint) is to a memory location (indicated by the "m"). The
33 * input constraint indicates that the source to the instruction
34 * is a register reference (indicated by the "r").
35 * The general format is:
36 * asm("<instruction template>" : <output> : <input> : <clobbers>);
37 * where <output> and <input> are:
38 * "<constraint>" (<token>)
39 * <instruction template> is the PA-RISC instruction in template fmt.
40 * <clobbers> indicates those registers clobbered by the instruction
41 * and provides hints to the optimizer.
42 *
43 * Refer to the gcc documentation or http://www.dis.com/gnu/gcc_toc.html
44 */
45 asm volatile (
46 "comiclr,= 0,%1,%%r28;
47 ldsid (%%r0,%1),%%r28;
48 stw %%r28, %0"
49 : "=m" (val) // Output to val
50 : "r" (source) // Source must be gen reg
51 : "%r28"); // Clobbers %r28
52 return (val);
53 };
54
55LONGPOINTER __perl_mpe_longaddr(void *source)
56 {
57 LONGPOINTER lptr;
58 /*
59 * Return the long pointer for the address in sr5 space.
60 */
61
62 asm volatile (
63 "comiclr,= 0,%2,%%r28;
64 ldsid (%%r0,%2),%%r28;
65 stw %%r28, %0;
66 stw %2, %1"
67 : "=m" (lptr.spaceid),
68 "=m" (lptr.offset) // Store to lptr
69 : "r" (source) // Source must be gen reg
70 : "%r28"); // Clobbers %r28
71 return (lptr);
72 };
73
74LONGPOINTER __perl_mpe_addtopointer(LONGPOINTER source, // %r26 == source offset
75 // %r25 == source space
76 int len) // %r24 == length in bytes
77 {
78 /*
79 * Increment a longpointer.
80 */
81
82 asm volatile (
83 "copy %0,%%r28; // copy space to r28
84 add %1,%2,%%r29" // Increment the pointer
85 : // No output
86 : "r" (source.spaceid), // Source address
87 "r" (source.offset),
88 "r" (len) // Length
89 : "%r28", // Clobbers
90 "%r29");
91 };
92
93void __perl_mpe_longmove(int len, // %r26 == byte length
94 LONGPOINTER source, // %r23 == source space, %r24 == off
95 LONGPOINTER target) // sp-#56 == target space, sp-#52== off
96 {
97 /*
98 * Move data between two buffers in long pointer space.
99 */
100
101 asm volatile (
102 ".import $$lr_unk_unk_long,MILLICODE;
103 mtsp %0,%%sr1; // copy source space to sr1
104 copy %1,%%r26; // load source offset to r26
105 copy %4,%%r24; // load length to r24
106 copy %3,%%r25; // load target offset to r25
107 bl $$lr_unk_unk_long,%%r31; // start branch to millicode
108 mtsp %2,%%sr2" // copy target space to sr2
109 : // No output
110 : "r" (source.spaceid), // Source address
111 "r" (source.offset),
112 "r" (target.spaceid), // Target address
113 "r" (target.offset),
114 "r" (len) // Byte length
115 : "%r1", // Clobbers
116 "%r24",
117 "%r25",
118 "%r26",
119 "%r31");
120 };
121
122int __perl_mpe_longpeek(LONGPOINTER source)
123 {
124 /*
125 * Fetch the int in long pointer space.
126 */
127 unsigned int val;
128
129 asm volatile (
130 "mtsp %1, %%sr1;
131 copy %2, %%r28;
132 ldw 0(%%sr1, %%r28), %%r28;
133 stw %%r28, %0"
134 : "=m" (val) // Output val
135 : "r" (source.spaceid), // Source space ID
136 "r" (source.offset) // Source offset
137 : "%r28"); // Clobbers %r28
138
139 return (val);
140 };
141
142void __perl_mpe_longpoke(LONGPOINTER target, // %r25 == spaceid, %r26 == offset
143 unsigned int val) // %r24 == value
144 {
145 /*
146 * Store the val into long pointer space.
147 */
148 asm volatile (
149 "mtsp %0,%%sr1;
150 copy %1, %%r28;
151 stw %2, 0(%%sr1, %%r28)"
152 : // No output
153 : "r" (target.spaceid), // Target space ID
154 "r" (target.offset), // Target offset
155 "r" (val) // Value to store
156 : "%r28" // Clobbers %r28
157 ); // Copy space to %sr1
158 };
159
160void __perl_mpe_move_fast(int len, // %r26 == byte length
161 void *source, // %r25 == source addr
162 void *target) // %r24 == target addr
163 {
164 /*
165 * Move using short pointers.
166 */
167 asm volatile (
168 ".import $$lr_unk_unk,MILLICODE;
169 copy %1, %%r26; // Move source addr into pos
170 copy %2, %%r25; // Move target addr into pos
171 bl $$lr_unk_unk,%%r31; // Start branch to millicode
172 copy %0, %%r24" // Move length into position
173 : // No output
174 : "r" (len), // Byte length
175 "r" (source), // Source address
176 "r" (target) // Target address
177 : "%r24", // Clobbers
178 "%r25",
179 "%r26",
180 "%r31");
181 };
182
183/*
184 * ftruncate - set file size, BSD Style
185 *
186 * shortens or enlarges the file as neeeded
187 * uses some undocumented locking call. It is known to work on SCO unix,
188 * other vendors should try.
189 * The #error directive prevents unsupported OSes
c72515e3
JH
190 *
191 * ftruncate/truncate code by Mark Bixby.
192 * This code is free software; you may redistribute it and/or modify
193 * it under the same terms as Perl itself.
194 *
feb33499
JH
195 */
196
197#include <unistd.h>
198#include <errno.h>
199#include <fcntl.h>
200#include <stdio.h>
201#include <mpe.h>
202
203extern void FCONTROL(short, short, longpointer);
204extern void PRINTFILEINFO(int);
205
206int ftruncate(int fd, long wantsize);
207
208int ftruncate(int fd, long wantsize) {
209
210int ccode_return,dummy=0;
211
212if (lseek(fd, wantsize, SEEK_SET) < 0) {
213 return (-1);
214}
215
216FCONTROL(_mpe_fileno(fd),6,__perl_mpe_longaddr(&dummy)); /* Write new EOF */
217if ((ccode_return=ccode()) != CCE) {
218 fprintf(stderr,"MPE ftruncate failed, ccode=%d, wantsize=%ld\n",ccode_return,wantsize);
219 PRINTFILEINFO(_mpe_fileno(fd));
220 errno = ESYSERR;
221 return (-1);
222}
223
224return (0);
225}
226
227/*
228 wrapper for truncate():
229
230 truncate() is UNIX, not POSIX.
231
232 This function requires ftruncate().
233
234
235
236 NAME
237 truncate -
238
239 SYNOPSIS
240 #include <unistd.h>
241
242 int truncate(const char *pathname, off_t length);
243
244 Returns: 0 if OK, -1 on error
245
246 from: Stevens' Advanced Programming in the UNIX Environment, p. 92
247
248
249
250 ERRORS
251 EACCES
252 EBADF
253 EDQUOT (not POSIX) <- not implemented here
254 EFAULT
255 EINVAL
256 EISDIR
257 ELOOP (not POSIX) <- not implemented here
258 ENAMETOOLONG
259 ENOTDIR
260 EROFS
261 ETXTBSY (not POSIX) <- not implemented here
262
263 from: HP-UX man page
264
265
266
267 Compile directives:
268 PRINT_ERROR - make this function print an error message to stderr
269*/
270
271#ifndef _POSIX_SOURCE
272# define _POSIX_SOURCE
273#endif
274
275#include <sys/types.h> /* off_t, required by open() */
276#include <sys/stat.h> /* required by open() */
277#include <fcntl.h> /* open() */
278#include <unistd.h> /* close() */
279#include <stdio.h> /* perror(), sprintf() */
280
281
282
283int
284truncate(const char *pathname, off_t length)
285{
286 int fd;
287#ifdef PRINT_ERROR
288 char error_msg[80+1];
289#endif
290
291 if (length == 0)
292 {
293 if ( (fd = open(pathname, O_WRONLY | O_TRUNC)) < 0)
294 {
295 /* errno already set */
296#ifdef PRINT_ERROR
297 sprintf(error_msg,
298 "truncate(): open(%s, O_WRONLY | OTRUNC)\0",
299 pathname);
300 perror(error_msg);
301#endif
302 return -1;
303 }
304 }
305 else
306 {
307 if ( (fd = open(pathname, O_WRONLY)) < 0)
308 {
309 /* errno already set */
310#ifdef PRINT_ERROR
311 sprintf(error_msg,
312 "truncate(): open(%s, O_WRONLY)\0",
313 pathname);
314 perror(error_msg);
315#endif
316 return -1;
317 }
318
319 if (ftruncate(fd, length) < 0)
320 {
321 /* errno already set */
322#ifdef PRINT_ERROR
323 perror("truncate(): ftruncate()");
324#endif
325 return -1;
326 }
327 }
328
329 if (close(fd) < 0)
330 {
331 /* errno already set */
332#ifdef PRINT_ERROR
333 perror("truncate(): close()");
334#endif
335 return -1;
336 }
337
338 return 0;
339} /* truncate() */
340
341/*
342 wrapper for gettimeofday():
343 gettimeofday() is UNIX, not POSIX.
344 gettimeofday() is a BSD function.
345
feb33499
JH
346 NAME
347 gettimeofday -
348
349 SYNOPSIS
350 #include <sys/time.h>
351
352 int gettimeofday(struct timeval *tp, struct timezone *tzp);
353
354 DESCRIPTION
355 This function returns seconds and microseconds since midnight
356 January 1, 1970. The microseconds is actually only accurate to
357 the millisecond.
358
359 Note: To pick up the definitions of structs timeval and timezone
360 from the <time.h> include file, the directive
361 _SOCKET_SOURCE must be used.
362
363 RETURN VALUE
364 A 0 return value indicates that the call succeeded. A -1 return
365 value indicates an error occurred; errno is set to indicate the
366 error.
367
368 ERRORS
369 EFAULT not implemented
370
371 Changes:
372 2-91 DR. Created.
373*/
374
375
376/* need _SOCKET_SOURCE to pick up structs timeval and timezone in time.h */
377#ifndef _SOCKET_SOURCE
378# define _SOCKET_SOURCE
379#endif
380
381#include <time.h> /* structs timeval & timezone,
382 difftime(), localtime(), mktime(), time() */
383#include <sys/time.h> /* gettimeofday() */
384
385extern int TIMER();
386
c72515e3
JH
387/*
388 * gettimeofday code by Mark Bixby.
389 * This code is free software; you may redistribute it and/or modify
390 * it under the same terms as Perl itself.
391 */
feb33499
JH
392
393#ifdef __STDC__
394int gettimeofday( struct timeval *tp, struct timezone *tpz )
395#else
396int gettimeofday( tp, tpz )
397struct timeval *tp;
398struct timezone *tpz;
399#endif
400{
401 static unsigned long basetime = 0;
402 static int dsttime = 0;
403 static int minuteswest = 0;
404 static int oldtime = 0;
405 register int newtime;
406
407
408 /*-------------------------------------------------------------------*/
409 /* Setup a base from which all future time will be computed. */
410 /*-------------------------------------------------------------------*/
411 if ( basetime == 0 )
412 {
413 time_t gmt_time;
414 time_t loc_time;
415 struct tm *loc_time_tm;
416
417 gmt_time = time( NULL );
418 loc_time_tm = localtime( &gmt_time ) ;
419 loc_time = mktime( loc_time_tm );
420
421 oldtime = TIMER();
422 basetime = (unsigned long) ( loc_time - (oldtime/1000) );
423
424 /*----------------------------------------------------------------*/
425 /* The calling process must be restarted if timezone or dst */
426 /* changes. */
427 /*----------------------------------------------------------------*/
428 minuteswest = (int) (difftime( loc_time, gmt_time ) / 60);
429 dsttime = loc_time_tm->tm_isdst;
430 }
431
432 /*-------------------------------------------------------------------*/
433 /* Get the new time value. The timer value rolls over every 24 days, */
434 /* so if the delta is negative, the basetime value is adjusted. */
435 /*-------------------------------------------------------------------*/
436 newtime = TIMER();
437 if ( newtime < oldtime ) basetime += 2073600;
438 oldtime = newtime;
439
440 /*-------------------------------------------------------------------*/
441 /* Return the timestamp info. */
442 /*-------------------------------------------------------------------*/
443 tp->tv_sec = basetime + newtime/1000;
444 tp->tv_usec = (newtime%1000) * 1000; /* only accurate to milli */
445 if (tpz)
446 {
447 tpz->tz_minuteswest = minuteswest;
448 tpz->tz_dsttime = dsttime;
449 }
450
451 return 0;
452
453} /* gettimeofday() */