summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--MANIFEST1
-rw-r--r--README.mpeix1
-rw-r--r--ext/DynaLoader/dl_mpeix.xs3
-rw-r--r--hints/mpeix.sh13
-rw-r--r--mpeix/mpeix.c444
-rw-r--r--mpeix/mpeixish.h13
6 files changed, 473 insertions, 2 deletions
diff --git a/MANIFEST b/MANIFEST
index 2b4c0bf11c..c0edb62ccf 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -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);