diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | README.mpeix | 1 | ||||
| -rw-r--r-- | ext/DynaLoader/dl_mpeix.xs | 3 | ||||
| -rw-r--r-- | hints/mpeix.sh | 13 | ||||
| -rw-r--r-- | mpeix/mpeix.c | 444 | ||||
| -rw-r--r-- | mpeix/mpeixish.h | 13 |
6 files changed, 473 insertions, 2 deletions
@@ -1864,6 +1864,7 @@ mint/README MiNT port mint/stdio.h MiNT port mint/sys/time.h MiNT port mint/time.h MiNT port +mpeix/mpeix.c MPE/iX port mpeix/mpeixish.h MPE/iX port mpeix/nm MPE/iX port mpeix/relink MPE/iX port diff --git a/README.mpeix b/README.mpeix index 926fbe6dfa..df61f1f8ad 100644 --- a/README.mpeix +++ b/README.mpeix @@ -9,6 +9,7 @@ README.mpeix - Perl/iX for HP e3000 MPE =head1 SYNOPSIS http://www.bixby.org/mark/perlix.html + http://jazz.external.hp.com/src/hp_freeware/perl/ Perl language for MPE Last updated June 2, 2000 @ 0400 UTC diff --git a/ext/DynaLoader/dl_mpeix.xs b/ext/DynaLoader/dl_mpeix.xs index 04796fba5f..b72d2c9fe8 100644 --- a/ext/DynaLoader/dl_mpeix.xs +++ b/ext/DynaLoader/dl_mpeix.xs @@ -3,6 +3,7 @@ * Version: 2.1, 1996/07/25 * Version: 2.2, 1997/09/25 Mark Bixby (markb@cccd.edu) * Version: 2.3, 1998/11/19 Mark Bixby (markb@cccd.edu) + * Version: 2.4, 2002/03/24 Mark Bixby (mark@bixby.org) */ #include "EXTERN.h" @@ -12,7 +13,7 @@ #ifdef __GNUC__ extern void HPGETPROCPLABEL( int parms, char * procname, - int * plabel, + void * plabel, int * status, char * firstfile, int casesensitive, diff --git a/hints/mpeix.sh b/hints/mpeix.sh index 6b4b877849..53db0152aa 100644 --- a/hints/mpeix.sh +++ b/hints/mpeix.sh @@ -11,6 +11,7 @@ # Substantially revised for 5.004_01 by Mark Bixby, markb@cccd.edu. # Revised again for 5.004_69 by Mark Bixby, markb@cccd.edu. # Revised for 5.6.0 by Mark Bixby, mbixby@power.net. +# Revised for 5.7.3 by Mark Bixby, mark@bixby.org. # osname='mpeix' osvers=`uname -r | sed -e 's/.[A-Z]\.\([0-9]\)\([0-9]\)\.[0-9][0-9]/\1.\2/'` @@ -30,7 +31,7 @@ alias -x cat=/bin/cat # Various directory locations. # # Which ones of these does Configure get wrong? -test -z "$prefix" && prefix='/PERL/PUB' +test -z "$prefix" && prefix="/$HPACCOUNT/$HPGROUP" archname='PA-RISC1.1' bin="$prefix" installman1dir="$prefix/man/man1" @@ -144,3 +145,13 @@ timetype='time_t' # bincompat5005="$undef" uselargefiles="$undef" +# +# Expected functionality provided in mpeix.c. +# +archobjs='mpeix.o' + +# Help gmake find mpeix.c +test -h mpeix.c || ln -s mpeix/mpeix.c mpeix.c + +d_gettimeod='define' +d_truncate='define' diff --git a/mpeix/mpeix.c b/mpeix/mpeix.c new file mode 100644 index 0000000000..7ad8eb2e83 --- /dev/null +++ b/mpeix/mpeix.c @@ -0,0 +1,444 @@ + +/* + * gcc long pointer support code for HPPA. + * Copyright 1998, DIS International, Ltd. + * Permission is granted to use this code under the GNU LIBRARY GENERAL + * PUBLIC LICENSE, Version 2, June 1991. + */ +typedef struct { + int spaceid; + unsigned int offset; + } LONGPOINTER, longpointer; + +/* + * gcc long pointer support code for HPPA. + * Copyright 1998, DIS International, Ltd. + * Permission is granted to use this code under the GNU LIBRARY GENERAL + * PUBLIC LICENSE, Version 2, June 1991. + */ + +int __perl_mpe_getspaceid(void *source) + { + int val; + /* + * Given the short pointer, determine it's space ID. + */ + + /* + * The colons separate output from input parameters. In this case, + * the output of the instruction (output indicated by the "=" in the + * constraint) is to a memory location (indicated by the "m"). The + * input constraint indicates that the source to the instruction + * is a register reference (indicated by the "r"). + * The general format is: + * asm("<instruction template>" : <output> : <input> : <clobbers>); + * where <output> and <input> are: + * "<constraint>" (<token>) + * <instruction template> is the PA-RISC instruction in template fmt. + * <clobbers> indicates those registers clobbered by the instruction + * and provides hints to the optimizer. + * + * Refer to the gcc documentation or http://www.dis.com/gnu/gcc_toc.html + */ + asm volatile ( + "comiclr,= 0,%1,%%r28; + ldsid (%%r0,%1),%%r28; + stw %%r28, %0" + : "=m" (val) // Output to val + : "r" (source) // Source must be gen reg + : "%r28"); // Clobbers %r28 + return (val); + }; + +LONGPOINTER __perl_mpe_longaddr(void *source) + { + LONGPOINTER lptr; + /* + * Return the long pointer for the address in sr5 space. + */ + + asm volatile ( + "comiclr,= 0,%2,%%r28; + ldsid (%%r0,%2),%%r28; + stw %%r28, %0; + stw %2, %1" + : "=m" (lptr.spaceid), + "=m" (lptr.offset) // Store to lptr + : "r" (source) // Source must be gen reg + : "%r28"); // Clobbers %r28 + return (lptr); + }; + +LONGPOINTER __perl_mpe_addtopointer(LONGPOINTER source, // %r26 == source offset + // %r25 == source space + int len) // %r24 == length in bytes + { + /* + * Increment a longpointer. + */ + + asm volatile ( + "copy %0,%%r28; // copy space to r28 + add %1,%2,%%r29" // Increment the pointer + : // No output + : "r" (source.spaceid), // Source address + "r" (source.offset), + "r" (len) // Length + : "%r28", // Clobbers + "%r29"); + }; + +void __perl_mpe_longmove(int len, // %r26 == byte length + LONGPOINTER source, // %r23 == source space, %r24 == off + LONGPOINTER target) // sp-#56 == target space, sp-#52== off + { + /* + * Move data between two buffers in long pointer space. + */ + + asm volatile ( + ".import $$lr_unk_unk_long,MILLICODE; + mtsp %0,%%sr1; // copy source space to sr1 + copy %1,%%r26; // load source offset to r26 + copy %4,%%r24; // load length to r24 + copy %3,%%r25; // load target offset to r25 + bl $$lr_unk_unk_long,%%r31; // start branch to millicode + mtsp %2,%%sr2" // copy target space to sr2 + : // No output + : "r" (source.spaceid), // Source address + "r" (source.offset), + "r" (target.spaceid), // Target address + "r" (target.offset), + "r" (len) // Byte length + : "%r1", // Clobbers + "%r24", + "%r25", + "%r26", + "%r31"); + }; + +int __perl_mpe_longpeek(LONGPOINTER source) + { + /* + * Fetch the int in long pointer space. + */ + unsigned int val; + + asm volatile ( + "mtsp %1, %%sr1; + copy %2, %%r28; + ldw 0(%%sr1, %%r28), %%r28; + stw %%r28, %0" + : "=m" (val) // Output val + : "r" (source.spaceid), // Source space ID + "r" (source.offset) // Source offset + : "%r28"); // Clobbers %r28 + + return (val); + }; + +void __perl_mpe_longpoke(LONGPOINTER target, // %r25 == spaceid, %r26 == offset + unsigned int val) // %r24 == value + { + /* + * Store the val into long pointer space. + */ + asm volatile ( + "mtsp %0,%%sr1; + copy %1, %%r28; + stw %2, 0(%%sr1, %%r28)" + : // No output + : "r" (target.spaceid), // Target space ID + "r" (target.offset), // Target offset + "r" (val) // Value to store + : "%r28" // Clobbers %r28 + ); // Copy space to %sr1 + }; + +void __perl_mpe_move_fast(int len, // %r26 == byte length + void *source, // %r25 == source addr + void *target) // %r24 == target addr + { + /* + * Move using short pointers. + */ + asm volatile ( + ".import $$lr_unk_unk,MILLICODE; + copy %1, %%r26; // Move source addr into pos + copy %2, %%r25; // Move target addr into pos + bl $$lr_unk_unk,%%r31; // Start branch to millicode + copy %0, %%r24" // Move length into position + : // No output + : "r" (len), // Byte length + "r" (source), // Source address + "r" (target) // Target address + : "%r24", // Clobbers + "%r25", + "%r26", + "%r31"); + }; + +/* + * ftruncate - set file size, BSD Style + * + * shortens or enlarges the file as neeeded + * uses some undocumented locking call. It is known to work on SCO unix, + * other vendors should try. + * The #error directive prevents unsupported OSes + */ + +#include <unistd.h> +#include <errno.h> +#include <fcntl.h> +#include <stdio.h> +#include <mpe.h> + +extern void FCONTROL(short, short, longpointer); +extern void PRINTFILEINFO(int); + +int ftruncate(int fd, long wantsize); + +int ftruncate(int fd, long wantsize) { + +int ccode_return,dummy=0; + +if (lseek(fd, wantsize, SEEK_SET) < 0) { + return (-1); +} + +FCONTROL(_mpe_fileno(fd),6,__perl_mpe_longaddr(&dummy)); /* Write new EOF */ +if ((ccode_return=ccode()) != CCE) { + fprintf(stderr,"MPE ftruncate failed, ccode=%d, wantsize=%ld\n",ccode_return,wantsize); + PRINTFILEINFO(_mpe_fileno(fd)); + errno = ESYSERR; + return (-1); +} + +return (0); +} + +/* + wrapper for truncate(): + + truncate() is UNIX, not POSIX. + + This function requires ftruncate(). + + + + NAME + truncate - + + SYNOPSIS + #include <unistd.h> + + int truncate(const char *pathname, off_t length); + + Returns: 0 if OK, -1 on error + + from: Stevens' Advanced Programming in the UNIX Environment, p. 92 + + + + ERRORS + EACCES + EBADF + EDQUOT (not POSIX) <- not implemented here + EFAULT + EINVAL + EISDIR + ELOOP (not POSIX) <- not implemented here + ENAMETOOLONG + ENOTDIR + EROFS + ETXTBSY (not POSIX) <- not implemented here + + from: HP-UX man page + + + + Compile directives: + PRINT_ERROR - make this function print an error message to stderr +*/ + +#ifndef _POSIX_SOURCE +# define _POSIX_SOURCE +#endif + +#include <sys/types.h> /* off_t, required by open() */ +#include <sys/stat.h> /* required by open() */ +#include <fcntl.h> /* open() */ +#include <unistd.h> /* close() */ +#include <stdio.h> /* perror(), sprintf() */ + + + +int +truncate(const char *pathname, off_t length) +{ + int fd; +#ifdef PRINT_ERROR + char error_msg[80+1]; +#endif + + if (length == 0) + { + if ( (fd = open(pathname, O_WRONLY | O_TRUNC)) < 0) + { + /* errno already set */ +#ifdef PRINT_ERROR + sprintf(error_msg, + "truncate(): open(%s, O_WRONLY | OTRUNC)\0", + pathname); + perror(error_msg); +#endif + return -1; + } + } + else + { + if ( (fd = open(pathname, O_WRONLY)) < 0) + { + /* errno already set */ +#ifdef PRINT_ERROR + sprintf(error_msg, + "truncate(): open(%s, O_WRONLY)\0", + pathname); + perror(error_msg); +#endif + return -1; + } + + if (ftruncate(fd, length) < 0) + { + /* errno already set */ +#ifdef PRINT_ERROR + perror("truncate(): ftruncate()"); +#endif + return -1; + } + } + + if (close(fd) < 0) + { + /* errno already set */ +#ifdef PRINT_ERROR + perror("truncate(): close()"); +#endif + return -1; + } + + return 0; +} /* truncate() */ + +/* + wrapper for gettimeofday(): + gettimeofday() is UNIX, not POSIX. + gettimeofday() is a BSD function. + + + + NAME + gettimeofday - + + SYNOPSIS + #include <sys/time.h> + + int gettimeofday(struct timeval *tp, struct timezone *tzp); + + DESCRIPTION + This function returns seconds and microseconds since midnight + January 1, 1970. The microseconds is actually only accurate to + the millisecond. + + Note: To pick up the definitions of structs timeval and timezone + from the <time.h> include file, the directive + _SOCKET_SOURCE must be used. + + RETURN VALUE + A 0 return value indicates that the call succeeded. A -1 return + value indicates an error occurred; errno is set to indicate the + error. + + ERRORS + EFAULT not implemented + + Changes: + 2-91 DR. Created. +*/ + + +/* need _SOCKET_SOURCE to pick up structs timeval and timezone in time.h */ +#ifndef _SOCKET_SOURCE +# define _SOCKET_SOURCE +#endif + +#include <time.h> /* structs timeval & timezone, + difftime(), localtime(), mktime(), time() */ +#include <sys/time.h> /* gettimeofday() */ + +extern int TIMER(); + + + +#ifdef __STDC__ +int gettimeofday( struct timeval *tp, struct timezone *tpz ) +#else +int gettimeofday( tp, tpz ) +struct timeval *tp; +struct timezone *tpz; +#endif +{ + static unsigned long basetime = 0; + static int dsttime = 0; + static int minuteswest = 0; + static int oldtime = 0; + register int newtime; + + + /*-------------------------------------------------------------------*/ + /* Setup a base from which all future time will be computed. */ + /*-------------------------------------------------------------------*/ + if ( basetime == 0 ) + { + time_t gmt_time; + time_t loc_time; + struct tm *loc_time_tm; + + gmt_time = time( NULL ); + loc_time_tm = localtime( &gmt_time ) ; + loc_time = mktime( loc_time_tm ); + + oldtime = TIMER(); + basetime = (unsigned long) ( loc_time - (oldtime/1000) ); + + /*----------------------------------------------------------------*/ + /* The calling process must be restarted if timezone or dst */ + /* changes. */ + /*----------------------------------------------------------------*/ + minuteswest = (int) (difftime( loc_time, gmt_time ) / 60); + dsttime = loc_time_tm->tm_isdst; + } + + /*-------------------------------------------------------------------*/ + /* Get the new time value. The timer value rolls over every 24 days, */ + /* so if the delta is negative, the basetime value is adjusted. */ + /*-------------------------------------------------------------------*/ + newtime = TIMER(); + if ( newtime < oldtime ) basetime += 2073600; + oldtime = newtime; + + /*-------------------------------------------------------------------*/ + /* Return the timestamp info. */ + /*-------------------------------------------------------------------*/ + tp->tv_sec = basetime + newtime/1000; + tp->tv_usec = (newtime%1000) * 1000; /* only accurate to milli */ + if (tpz) + { + tpz->tz_minuteswest = minuteswest; + tpz->tz_dsttime = dsttime; + } + + return 0; + +} /* gettimeofday() */ diff --git a/mpeix/mpeixish.h b/mpeix/mpeixish.h index dc8cb1939a..e0375055eb 100644 --- a/mpeix/mpeixish.h +++ b/mpeix/mpeixish.h @@ -140,3 +140,16 @@ extern key_t ftok (char *pathname, char id); extern char *gcvt (double value, int ndigit, char *buf); extern int isnan (double value); extern void srand48(long int seedval); + +/* various missing constants -- define 'em */ + +#define PF_UNSPEC 0 + +/* declarations for wrappers in mpeix.c */ + +#include <time.h> +#include <sys/time.h> + +extern int ftruncate(int fd, long wantsize); +extern int gettimeofday( struct timeval *tp, struct timezone *tpz ); +extern int truncate(const char *pathname, off_t length); |