summaryrefslogtreecommitdiff
path: root/ext
diff options
context:
space:
mode:
Diffstat (limited to 'ext')
-rw-r--r--ext/dbm/GDBM_File.c58
-rw-r--r--ext/dbm/Makefile14
-rw-r--r--ext/dbm/ODBM_File.c48
-rw-r--r--ext/dbm/SDBM_File.c266
-rw-r--r--ext/dbm/sdbm/makefile2
-rw-r--r--ext/dbm/typemap24
-rw-r--r--ext/dl/dl.c54
-rw-r--r--ext/dl/eg/Makefile20
-rw-r--r--ext/dl/eg/Makefile.att18
-rw-r--r--ext/dl/eg/main.c28
-rw-r--r--ext/dl/eg/test.c4
-rw-r--r--ext/dl/eg/test1.c11
-rw-r--r--ext/posix/POSIX.xs209
-rw-r--r--ext/posix/typemap4
-rw-r--r--ext/typemap346
-rw-r--r--ext/typemap.oi99
-rw-r--r--ext/typemap.xlib97
-rw-r--r--ext/typemap.xpm7
-rwxr-xr-xext/xsubpp367
19 files changed, 915 insertions, 761 deletions
diff --git a/ext/dbm/GDBM_File.c b/ext/dbm/GDBM_File.c
index b5d4a8884a..f940a594cc 100644
--- a/ext/dbm/GDBM_File.c
+++ b/ext/dbm/GDBM_File.c
@@ -21,7 +21,7 @@ register int sp;
register int items;
{
if (items < 5 || items > 6) {
- fatal("Usage: GDBM_File::new(dbtype, name, block_size, read_write, mode, fatal_func = (FATALFUNC)fatal)");
+ croak("Usage: GDBM_File::new(dbtype, name, block_size, read_write, mode, fatal_func = (FATALFUNC)croak)");
}
{
char * dbtype = SvPV(ST(1),na);
@@ -33,7 +33,7 @@ register int items;
GDBM_File RETVAL;
if (items < 6)
- fatal_func = (FATALFUNC)fatal;
+ fatal_func = (FATALFUNC)croak;
else {
fatal_func = (FATALFUNC)SvPV(ST(6),na);
}
@@ -52,7 +52,7 @@ register int sp;
register int items;
{
if (items < 4 || items > 5) {
- fatal("Usage: GDBM_File::open(name, block_size, read_write, mode, fatal_func = (FATALFUNC)fatal)");
+ croak("Usage: GDBM_File::open(name, block_size, read_write, mode, fatal_func = (FATALFUNC)croak)");
}
{
char * name = SvPV(ST(1),na);
@@ -63,7 +63,7 @@ register int items;
GDBM_File RETVAL;
if (items < 5)
- fatal_func = (FATALFUNC)fatal;
+ fatal_func = (FATALFUNC)croak;
else {
fatal_func = (FATALFUNC)SvPV(ST(5),na);
}
@@ -82,15 +82,15 @@ register int sp;
register int items;
{
if (items < 1 || items > 1) {
- fatal("Usage: GDBM_File::close(db)");
+ croak("Usage: GDBM_File::close(db)");
}
{
GDBM_File db;
if (sv_isa(ST(1), "GDBM_File"))
- db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+ db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
else
- fatal("db is not of type GDBM_File");
+ croak("db is not of type GDBM_File");
gdbm_close(db);
}
@@ -104,15 +104,15 @@ register int sp;
register int items;
{
if (items < 1 || items > 1) {
- fatal("Usage: GDBM_File::DESTROY(db)");
+ croak("Usage: GDBM_File::DESTROY(db)");
}
{
GDBM_File db;
if (sv_isa(ST(1), "GDBM_File"))
- db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+ db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
else
- fatal("db is not of type GDBM_File");
+ croak("db is not of type GDBM_File");
gdbm_close(db);
}
return sp;
@@ -125,7 +125,7 @@ register int sp;
register int items;
{
if (items < 2 || items > 2) {
- fatal("Usage: GDBM_File::fetch(db, key)");
+ croak("Usage: GDBM_File::fetch(db, key)");
}
{
GDBM_File db;
@@ -133,9 +133,9 @@ register int items;
gdatum RETVAL;
if (sv_isa(ST(1), "GDBM_File"))
- db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+ db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
else
- fatal("db is not of type GDBM_File");
+ croak("db is not of type GDBM_File");
key.dptr = SvPV(ST(2), key.dsize);;
@@ -153,7 +153,7 @@ register int sp;
register int items;
{
if (items < 3 || items > 4) {
- fatal("Usage: GDBM_File::store(db, key, value, flags = GDBM_REPLACE)");
+ croak("Usage: GDBM_File::store(db, key, value, flags = GDBM_REPLACE)");
}
{
GDBM_File db;
@@ -163,9 +163,9 @@ register int items;
int RETVAL;
if (sv_isa(ST(1), "GDBM_File"))
- db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+ db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
else
- fatal("db is not of type GDBM_File");
+ croak("db is not of type GDBM_File");
key.dptr = SvPV(ST(2), key.dsize);;
@@ -191,7 +191,7 @@ register int sp;
register int items;
{
if (items < 2 || items > 2) {
- fatal("Usage: GDBM_File::delete(db, key)");
+ croak("Usage: GDBM_File::delete(db, key)");
}
{
GDBM_File db;
@@ -199,9 +199,9 @@ register int items;
int RETVAL;
if (sv_isa(ST(1), "GDBM_File"))
- db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+ db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
else
- fatal("db is not of type GDBM_File");
+ croak("db is not of type GDBM_File");
key.dptr = SvPV(ST(2), key.dsize);;
@@ -219,16 +219,16 @@ register int sp;
register int items;
{
if (items < 1 || items > 1) {
- fatal("Usage: GDBM_File::firstkey(db)");
+ croak("Usage: GDBM_File::firstkey(db)");
}
{
GDBM_File db;
gdatum RETVAL;
if (sv_isa(ST(1), "GDBM_File"))
- db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+ db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
else
- fatal("db is not of type GDBM_File");
+ croak("db is not of type GDBM_File");
RETVAL = gdbm_firstkey(db);
ST(0) = sv_mortalcopy(&sv_undef);
@@ -244,7 +244,7 @@ register int sp;
register int items;
{
if (items < 2 || items > 2) {
- fatal("Usage: GDBM_File::nextkey(db, key)");
+ croak("Usage: GDBM_File::nextkey(db, key)");
}
{
GDBM_File db;
@@ -252,9 +252,9 @@ register int items;
gdatum RETVAL;
if (sv_isa(ST(1), "GDBM_File"))
- db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+ db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
else
- fatal("db is not of type GDBM_File");
+ croak("db is not of type GDBM_File");
key.dptr = SvPV(ST(2), key.dsize);;
@@ -272,16 +272,16 @@ register int sp;
register int items;
{
if (items < 1 || items > 1) {
- fatal("Usage: GDBM_File::reorganize(db)");
+ croak("Usage: GDBM_File::reorganize(db)");
}
{
GDBM_File db;
int RETVAL;
if (sv_isa(ST(1), "GDBM_File"))
- db = (GDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+ db = (GDBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
else
- fatal("db is not of type GDBM_File");
+ croak("db is not of type GDBM_File");
RETVAL = gdbm_reorganize(db);
ST(0) = sv_mortalcopy(&sv_undef);
@@ -290,7 +290,7 @@ register int items;
return sp;
}
-int init_GDBM_File(ix,sp,items)
+int boot_GDBM_File(ix,sp,items)
int ix;
int sp;
int items;
diff --git a/ext/dbm/Makefile b/ext/dbm/Makefile
index 61afe01e64..970724dd2a 100644
--- a/ext/dbm/Makefile
+++ b/ext/dbm/Makefile
@@ -1,14 +1,20 @@
all: NDBM_File.c ODBM_File.c GDBM_File.c SDBM_File.c
NDBM_File.c: NDBM_File.xs
- ../xsubpp ../typemap NDBM_File.xs >NDBM_File.c
+ ../xsubpp NDBM_File.xs >NDBM_File.c
SDBM_File.c: SDBM_File.xs
- ../xsubpp ../typemap SDBM_File.xs >SDBM_File.c
+ ../xsubpp SDBM_File.xs >SDBM_File.c
+
+SDBM_File.o: SDBM_File.c
+ cc -g -I../.. -pic -c SDBM_File.c
+
+SDBM_File.so: SDBM_File.o sdbm/libsdbm.a
+ ld -o SDBM_File.so SDBM_File.o sdbm/libsdbm.a
ODBM_File.c: ODBM_File.xs
- ../xsubpp ../typemap ODBM_File.xs >ODBM_File.c
+ ../xsubpp ODBM_File.xs >ODBM_File.c
GDBM_File.c: GDBM_File.xs
- ../xsubpp ../typemap GDBM_File.xs >GDBM_File.c
+ ../xsubpp GDBM_File.xs >GDBM_File.c
diff --git a/ext/dbm/ODBM_File.c b/ext/dbm/ODBM_File.c
index b2fa7ddcba..1aea2cec53 100644
--- a/ext/dbm/ODBM_File.c
+++ b/ext/dbm/ODBM_File.c
@@ -28,7 +28,7 @@ register int sp;
register int items;
{
if (items < 4 || items > 4) {
- fatal("Usage: ODBM_File::new(dbtype, filename, flags, mode)");
+ croak("Usage: ODBM_File::new(dbtype, filename, flags, mode)");
}
{
char * dbtype = SvPV(ST(1),na);
@@ -39,18 +39,18 @@ register int items;
{
char tmpbuf[1025];
if (dbmrefcnt++)
- fatal("Old dbm can only open one database");
+ croak("Old dbm can only open one database");
sprintf(tmpbuf,"%s.dir",filename);
if (stat(tmpbuf, &statbuf) < 0) {
if (flags & O_CREAT) {
if (mode < 0 || close(creat(tmpbuf,mode)) < 0)
- fatal("ODBM_File: Can't create %s", filename);
+ croak("ODBM_File: Can't create %s", filename);
sprintf(tmpbuf,"%s.pag",filename);
if (close(creat(tmpbuf,mode)) < 0)
- fatal("ODBM_File: Can't create %s", filename);
+ croak("ODBM_File: Can't create %s", filename);
}
else
- fatal("ODBM_FILE: Can't open %s", filename);
+ croak("ODBM_FILE: Can't open %s", filename);
}
RETVAL = (void*)(dbminit(filename) >= 0 ? &dbmrefcnt : 0);
ST(0) = sv_mortalcopy(&sv_undef);
@@ -67,15 +67,15 @@ register int sp;
register int items;
{
if (items < 1 || items > 1) {
- fatal("Usage: ODBM_File::DESTROY(db)");
+ croak("Usage: ODBM_File::DESTROY(db)");
}
{
ODBM_File db;
if (sv_isa(ST(1), "ODBM_File"))
- db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+ db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
else
- fatal("db is not of type ODBM_File");
+ croak("db is not of type ODBM_File");
dbmrefcnt--;
dbmclose();
}
@@ -89,7 +89,7 @@ register int sp;
register int items;
{
if (items < 2 || items > 2) {
- fatal("Usage: ODBM_File::fetch(db, key)");
+ croak("Usage: ODBM_File::fetch(db, key)");
}
{
ODBM_File db;
@@ -97,9 +97,9 @@ register int items;
datum RETVAL;
if (sv_isa(ST(1), "ODBM_File"))
- db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+ db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
else
- fatal("db is not of type ODBM_File");
+ croak("db is not of type ODBM_File");
key.dptr = SvPV(ST(2), key.dsize);;
@@ -117,7 +117,7 @@ register int sp;
register int items;
{
if (items < 3 || items > 4) {
- fatal("Usage: ODBM_File::store(db, key, value, flags = DBM_REPLACE)");
+ croak("Usage: ODBM_File::store(db, key, value, flags = DBM_REPLACE)");
}
{
ODBM_File db;
@@ -127,9 +127,9 @@ register int items;
int RETVAL;
if (sv_isa(ST(1), "ODBM_File"))
- db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+ db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
else
- fatal("db is not of type ODBM_File");
+ croak("db is not of type ODBM_File");
key.dptr = SvPV(ST(2), key.dsize);;
@@ -155,7 +155,7 @@ register int sp;
register int items;
{
if (items < 2 || items > 2) {
- fatal("Usage: ODBM_File::delete(db, key)");
+ croak("Usage: ODBM_File::delete(db, key)");
}
{
ODBM_File db;
@@ -163,9 +163,9 @@ register int items;
int RETVAL;
if (sv_isa(ST(1), "ODBM_File"))
- db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+ db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
else
- fatal("db is not of type ODBM_File");
+ croak("db is not of type ODBM_File");
key.dptr = SvPV(ST(2), key.dsize);;
@@ -183,16 +183,16 @@ register int sp;
register int items;
{
if (items < 1 || items > 1) {
- fatal("Usage: ODBM_File::firstkey(db)");
+ croak("Usage: ODBM_File::firstkey(db)");
}
{
ODBM_File db;
datum RETVAL;
if (sv_isa(ST(1), "ODBM_File"))
- db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+ db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
else
- fatal("db is not of type ODBM_File");
+ croak("db is not of type ODBM_File");
RETVAL = odbm_firstkey(db);
ST(0) = sv_mortalcopy(&sv_undef);
@@ -208,7 +208,7 @@ register int sp;
register int items;
{
if (items < 2 || items > 2) {
- fatal("Usage: ODBM_File::nextkey(db, key)");
+ croak("Usage: ODBM_File::nextkey(db, key)");
}
{
ODBM_File db;
@@ -216,9 +216,9 @@ register int items;
datum RETVAL;
if (sv_isa(ST(1), "ODBM_File"))
- db = (ODBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
+ db = (ODBM_File)(unsigned long)SvNV((SV*)SvRV(ST(1)));
else
- fatal("db is not of type ODBM_File");
+ croak("db is not of type ODBM_File");
key.dptr = SvPV(ST(2), key.dsize);;
@@ -229,7 +229,7 @@ register int items;
return sp;
}
-int init_ODBM_File(ix,sp,items)
+int boot_ODBM_File(ix,sp,items)
int ix;
int sp;
int items;
diff --git a/ext/dbm/SDBM_File.c b/ext/dbm/SDBM_File.c
index 7baafc4a98..e69de29bb2 100644
--- a/ext/dbm/SDBM_File.c
+++ b/ext/dbm/SDBM_File.c
@@ -1,266 +0,0 @@
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-#include "ext/dbm/sdbm/sdbm.h"
-
-typedef DBM* SDBM_File;
-#define sdbm_new(dbtype,filename,flags,mode) sdbm_open(filename,flags,mode)
-
-static int
-XS_SDBM_File_sdbm_new(ix, sp, items)
-register int ix;
-register int sp;
-register int items;
-{
- if (items < 4 || items > 4) {
- fatal("Usage: SDBM_File::new(dbtype, filename, flags, mode)");
- }
- {
- char * dbtype = SvPV(ST(1),na);
- char * filename = SvPV(ST(2),na);
- int flags = (int)SvIV(ST(3));
- int mode = (int)SvIV(ST(4));
- SDBM_File RETVAL;
-
- RETVAL = sdbm_new(dbtype, filename, flags, mode);
- ST(0) = sv_mortalcopy(&sv_undef);
- sv_setptrobj(ST(0), RETVAL, "SDBM_File");
- }
- return sp;
-}
-
-static int
-XS_SDBM_File_sdbm_DESTROY(ix, sp, items)
-register int ix;
-register int sp;
-register int items;
-{
- if (items < 1 || items > 1) {
- fatal("Usage: SDBM_File::DESTROY(db)");
- }
- {
- SDBM_File db;
-
- if (sv_isa(ST(1), "SDBM_File"))
- db = (SDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
- else
- fatal("db is not of type SDBM_File");
- sdbm_close(db);
- }
- return sp;
-}
-
-static int
-XS_SDBM_File_sdbm_fetch(ix, sp, items)
-register int ix;
-register int sp;
-register int items;
-{
- if (items < 2 || items > 2) {
- fatal("Usage: SDBM_File::fetch(db, key)");
- }
- {
- SDBM_File db;
- datum key;
- datum RETVAL;
-
- if (sv_isa(ST(1), "SDBM_File"))
- db = (SDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
- else
- fatal("db is not of type SDBM_File");
-
- key.dptr = SvPV(ST(2), key.dsize);;
-
- RETVAL = sdbm_fetch(db, key);
- ST(0) = sv_mortalcopy(&sv_undef);
- sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
- }
- return sp;
-}
-
-static int
-XS_SDBM_File_sdbm_store(ix, sp, items)
-register int ix;
-register int sp;
-register int items;
-{
- if (items < 3 || items > 4) {
- fatal("Usage: SDBM_File::store(db, key, value, flags = DBM_REPLACE)");
- }
- {
- SDBM_File db;
- datum key;
- datum value;
- int flags;
- int RETVAL;
-
- if (sv_isa(ST(1), "SDBM_File"))
- db = (SDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
- else
- fatal("db is not of type SDBM_File");
-
- key.dptr = SvPV(ST(2), key.dsize);;
-
- value.dptr = SvPV(ST(3), value.dsize);;
-
- if (items < 4)
- flags = DBM_REPLACE;
- else {
- flags = (int)SvIV(ST(4));
- }
-
- RETVAL = sdbm_store(db, key, value, flags);
- ST(0) = sv_mortalcopy(&sv_undef);
- sv_setiv(ST(0), (I32)RETVAL);
- }
- return sp;
-}
-
-static int
-XS_SDBM_File_sdbm_delete(ix, sp, items)
-register int ix;
-register int sp;
-register int items;
-{
- if (items < 2 || items > 2) {
- fatal("Usage: SDBM_File::delete(db, key)");
- }
- {
- SDBM_File db;
- datum key;
- int RETVAL;
-
- if (sv_isa(ST(1), "SDBM_File"))
- db = (SDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
- else
- fatal("db is not of type SDBM_File");
-
- key.dptr = SvPV(ST(2), key.dsize);;
-
- RETVAL = sdbm_delete(db, key);
- ST(0) = sv_mortalcopy(&sv_undef);
- sv_setiv(ST(0), (I32)RETVAL);
- }
- return sp;
-}
-
-static int
-XS_SDBM_File_sdbm_firstkey(ix, sp, items)
-register int ix;
-register int sp;
-register int items;
-{
- if (items < 1 || items > 1) {
- fatal("Usage: SDBM_File::firstkey(db)");
- }
- {
- SDBM_File db;
- datum RETVAL;
-
- if (sv_isa(ST(1), "SDBM_File"))
- db = (SDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
- else
- fatal("db is not of type SDBM_File");
-
- RETVAL = sdbm_firstkey(db);
- ST(0) = sv_mortalcopy(&sv_undef);
- sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
- }
- return sp;
-}
-
-static int
-XS_SDBM_File_sdbm_nextkey(ix, sp, items)
-register int ix;
-register int sp;
-register int items;
-{
- if (items < 2 || items > 2) {
- fatal("Usage: SDBM_File::nextkey(db, key)");
- }
- {
- SDBM_File db;
- datum key;
- datum RETVAL;
-
- if (sv_isa(ST(1), "SDBM_File"))
- db = (SDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
- else
- fatal("db is not of type SDBM_File");
-
- key.dptr = SvPV(ST(2), key.dsize);;
-
- RETVAL = sdbm_nextkey(db, key);
- ST(0) = sv_mortalcopy(&sv_undef);
- sv_setpvn(ST(0), RETVAL.dptr, RETVAL.dsize);
- }
- return sp;
-}
-
-static int
-XS_SDBM_File_sdbm_error(ix, sp, items)
-register int ix;
-register int sp;
-register int items;
-{
- if (items < 1 || items > 1) {
- fatal("Usage: SDBM_File::error(db)");
- }
- {
- SDBM_File db;
- int RETVAL;
-
- if (sv_isa(ST(1), "SDBM_File"))
- db = (SDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
- else
- fatal("db is not of type SDBM_File");
-
- RETVAL = sdbm_error(db);
- ST(0) = sv_mortalcopy(&sv_undef);
- sv_setiv(ST(0), (I32)RETVAL);
- }
- return sp;
-}
-
-static int
-XS_SDBM_File_sdbm_clearerr(ix, sp, items)
-register int ix;
-register int sp;
-register int items;
-{
- if (items < 1 || items > 1) {
- fatal("Usage: SDBM_File::clearerr(db)");
- }
- {
- SDBM_File db;
- int RETVAL;
-
- if (sv_isa(ST(1), "SDBM_File"))
- db = (SDBM_File)(unsigned long)SvNV((SV*)SvANY(ST(1)));
- else
- fatal("db is not of type SDBM_File");
-
- RETVAL = sdbm_clearerr(db);
- ST(0) = sv_mortalcopy(&sv_undef);
- sv_setiv(ST(0), (I32)RETVAL);
- }
- return sp;
-}
-
-int init_SDBM_File(ix,sp,items)
-int ix;
-int sp;
-int items;
-{
- char* file = __FILE__;
-
- newXSUB("SDBM_File::new", 0, XS_SDBM_File_sdbm_new, file);
- newXSUB("SDBM_File::DESTROY", 0, XS_SDBM_File_sdbm_DESTROY, file);
- newXSUB("SDBM_File::fetch", 0, XS_SDBM_File_sdbm_fetch, file);
- newXSUB("SDBM_File::store", 0, XS_SDBM_File_sdbm_store, file);
- newXSUB("SDBM_File::delete", 0, XS_SDBM_File_sdbm_delete, file);
- newXSUB("SDBM_File::firstkey", 0, XS_SDBM_File_sdbm_firstkey, file);
- newXSUB("SDBM_File::nextkey", 0, XS_SDBM_File_sdbm_nextkey, file);
- newXSUB("SDBM_File::error", 0, XS_SDBM_File_sdbm_error, file);
- newXSUB("SDBM_File::clearerr", 0, XS_SDBM_File_sdbm_clearerr, file);
-}
diff --git a/ext/dbm/sdbm/makefile b/ext/dbm/sdbm/makefile
index 5dabe40242..c959c1fab5 100644
--- a/ext/dbm/sdbm/makefile
+++ b/ext/dbm/sdbm/makefile
@@ -2,7 +2,7 @@
# makefile for public domain ndbm-clone: sdbm
# DUFF: use duff's device (loop unroll) in parts of the code
#
-CFLAGS = -O -DSDBM -DDUFF -DBSD42
+CFLAGS = -O -DSDBM -DDUFF -DBSD42 -pic
#LDFLAGS = -p
OBJS = sdbm.o pair.o hash.o
diff --git a/ext/dbm/typemap b/ext/dbm/typemap
new file mode 100644
index 0000000000..13147faa45
--- /dev/null
+++ b/ext/dbm/typemap
@@ -0,0 +1,24 @@
+#
+#################################### DBM SECTION
+#
+
+datum T_DATUM
+gdatum T_GDATUM
+NDBM_File T_PTROBJ
+GDBM_File T_PTROBJ
+SDBM_File T_PTROBJ
+ODBM_File T_PTROBJ
+DB_File T_PTROBJ
+DBZ_File T_PTROBJ
+FATALFUNC T_OPAQUEPTR
+
+INPUT
+T_DATUM
+ $var.dptr = SvPV($arg, $var.dsize);
+T_GDATUM
+ UNIMPLEMENTED
+OUTPUT
+T_DATUM
+ sv_setpvn($arg, $var.dptr, $var.dsize);
+T_GDATUM
+ sv_usepvn($arg, $var.dptr, $var.dsize);
diff --git a/ext/dl/dl.c b/ext/dl/dl.c
new file mode 100644
index 0000000000..38a798cfc1
--- /dev/null
+++ b/ext/dl/dl.c
@@ -0,0 +1,54 @@
+#include <dlfcn.h>
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+static int
+XS_DynamicLoader_bootstrap(ix, sp, items)
+register int ix;
+register int sp;
+register int items;
+{
+ if (items < 1 || items > 1) {
+ croak("Usage: DynamicLoader::bootstrap(package)");
+ }
+ {
+ char* package = SvPV(ST(1),na);
+ void* obj = 0;
+ int (*bootproc)();
+ char tmpbuf[1024];
+ char tmpbuf2[128];
+ AV *av = GvAVn(incgv);
+ I32 i;
+
+ for (i = 0; i <= AvFILL(av); i++) {
+ (void)sprintf(tmpbuf, "%s/auto/%s/%s.so",
+ SvPVx(*av_fetch(av, i, TRUE), na), package, package);
+ if (obj = dlopen(tmpbuf,1))
+ break;
+ }
+ if (!obj)
+ croak("Can't find loadable object for package %s in @INC", package);
+
+ sprintf(tmpbuf2, "boot_%s", package);
+ bootproc = (int (*)())dlsym(obj, tmpbuf2);
+ if (!bootproc)
+ croak("Shared object %s contains no %s function", tmpbuf, tmpbuf2);
+ bootproc();
+
+ ST(0) = sv_mortalcopy(&sv_yes);
+ }
+ return sp;
+}
+
+int
+boot_DynamicLoader(ix,sp,items)
+int ix;
+int sp;
+int items;
+{
+ char* file = __FILE__;
+
+ newXSUB("DynamicLoader::bootstrap", 0, XS_DynamicLoader_bootstrap, file);
+}
diff --git a/ext/dl/eg/Makefile b/ext/dl/eg/Makefile
new file mode 100644
index 0000000000..d1ae210730
--- /dev/null
+++ b/ext/dl/eg/Makefile
@@ -0,0 +1,20 @@
+CC = /vol/apps/lucid-3.1/lcc
+
+all: main test test1
+main: main.c
+ $(CC) -g -o main main.c -ldl
+
+test.o: test.c
+ $(CC) -g -pic -c test.c
+
+test: test.o
+ ld -o test -assert pure-text test.o
+
+test1.o: test1.c
+ $(CC) -g -pic -c test1.c
+
+test1: test1.o
+ ld -o test1 -assert pure-text test1.o
+
+clean:
+ /bin/rm -f *.o test test1 main
diff --git a/ext/dl/eg/Makefile.att b/ext/dl/eg/Makefile.att
new file mode 100644
index 0000000000..435b916f67
--- /dev/null
+++ b/ext/dl/eg/Makefile.att
@@ -0,0 +1,18 @@
+all: main test test1
+main: main.c
+ cc -g -o main main.c -ldl
+
+test.o: test.c
+ cc -g -pic -c test.c
+
+test: test.o
+ cc -o test -G test.o
+
+test1.o: test1.c
+ cc -g -pic -c test1.c
+
+test1: test1.o
+ cc -o test1 -G test1.o
+
+clean:
+ /bin/rm -f *.o test test1 main
diff --git a/ext/dl/eg/main.c b/ext/dl/eg/main.c
new file mode 100644
index 0000000000..ac0155453e
--- /dev/null
+++ b/ext/dl/eg/main.c
@@ -0,0 +1,28 @@
+#include <dlfcn.h>
+#include <stdio.h>
+
+main(argc, argv, arge)
+int argc;
+char **argv;
+char **arge;
+{
+ void *obj;
+ void (*proc)();
+ void *obj1;
+ void (*proc1)();
+
+ if (!(obj = dlopen("test", 1)))
+ fprintf(stderr, "%s\n", dlerror());
+ if (!(obj1 = dlopen("test1", 1)))
+ fprintf(stderr, "%s\n", dlerror());
+ proc = (void (*)())dlsym(obj, "test");
+ proc1 = (void (*)())dlsym(obj1, "test1");
+ proc();
+ proc1();
+ dlclose(obj);
+}
+
+void print()
+{
+ printf("got here!\n");
+}
diff --git a/ext/dl/eg/test.c b/ext/dl/eg/test.c
new file mode 100644
index 0000000000..a66db198cf
--- /dev/null
+++ b/ext/dl/eg/test.c
@@ -0,0 +1,4 @@
+test()
+{
+ print();
+}
diff --git a/ext/dl/eg/test1.c b/ext/dl/eg/test1.c
new file mode 100644
index 0000000000..fc7b1b2cc2
--- /dev/null
+++ b/ext/dl/eg/test1.c
@@ -0,0 +1,11 @@
+#include <dlfcn.h>
+
+test1()
+{
+ void *obj;
+ void (*proc)();
+
+ obj = dlopen("test", 1);
+ proc = (void (*)())dlsym(obj, "test");
+ proc();
+}
diff --git a/ext/posix/POSIX.xs b/ext/posix/POSIX.xs
index 5918199cd8..7981f8818b 100644
--- a/ext/posix/POSIX.xs
+++ b/ext/posix/POSIX.xs
@@ -1,10 +1,215 @@
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
+#include <sys/utsname.h>
+
+#define HAS_UNAME
+
+#ifndef HAS_GETPGRP
+#define getpgrp(a,b) not_here("getpgrp")
+#endif
+#ifndef HAS_NICE
+#define nice(a) not_here("nice")
+#endif
+#ifndef HAS_READLINK
+#define readlink(a,b,c) not_here("readlink")
+#endif
+#ifndef HAS_SETPGID
+#define setpgid(a,b) not_here("setpgid")
+#endif
+#ifndef HAS_SETPGRP
+#define setpgrp(a,b) not_here("setpgrp")
+#endif
+#ifndef HAS_SETSID
+#define setsid() not_here("setsid")
+#endif
+#ifndef HAS_SYMLINK
+#define symlink(a,b) not_here("symlink")
+#endif
+#ifndef HAS_TCGETPGRP
+#define tcgetpgrp(a) not_here("tcgetpgrp")
+#endif
+#ifndef HAS_TCSETPGRP
+#define tcsetpgrp(a,b) not_here("tcsetpgrp")
+#endif
+#ifndef HAS_TIMES
+#define times(a) not_here("times")
+#endif
+#ifndef HAS_UNAME
+#define uname(a) not_here("uname")
+#endif
+#ifndef HAS_WAITPID
+#define waitpid(a,b,c) not_here("waitpid")
+#endif
+
+static int
+not_here(s)
+char *s;
+{
+ croak("POSIX::%s not implemented on this architecture", s);
+ return -1;
+}
MODULE = POSIX PACKAGE = POSIX
+void
+_exit(status)
+ int status
+
+int
+chdir(path)
+ char * path
+
+int
+chmod(path, mode)
+ char * path
+ mode_t mode
+
+int
+close(fd)
+ int fd
+
+int
+dup(fd)
+ int fd
+
+int
+dup2(fd1, fd2)
+ int fd1
+ int fd2
+
FILE *
-fdopen(fildes, type)
- fd fildes
+fdopen(fd, type)
+ int fd
char * type
+
+int
+fstat(fd, buf)
+ int fd
+ struct stat * buf = (struct stat*)sv_grow(ST(2),sizeof(struct stat));
+ CLEANUP:
+ SvCUR(ST(2)) = sizeof(struct stat);
+
+int
+getpgrp(pid)
+ int pid
+
+int
+link()
+
+int
+lseek()
+
+int
+lstat()
+
+int
+mkdir()
+
+int
+nice(incr)
+ int incr
+
+int
+open()
+
+int
+pipe()
+
+int
+read()
+
+int
+readlink(path, buf, bufsiz)
+ char * path
+ char * buf = sv_grow(ST(2), SvIV(ST(3)));
+ int bufsiz
+
+int
+rename()
+
+int
+rmdir()
+
+int
+setgid()
+
+int
+setpgid(pid, pgid)
+ pid_t pid
+ pid_t pgid
+
+int
+setpgrp(pid, pgrp)
+ int pid
+ int pgrp
+
+pid_t
+setsid()
+
+int
+setuid()
+
+int
+stat()
+
+int
+symlink()
+
+int
+system()
+
+pid_t
+tcgetpgrp(fd)
+ int fd
+
+int
+tcsetpgrp(fd, pgrp_id)
+ int fd
+ pid_t pgrp_id
+
+int
+times(tms)
+ struct tms * tms = (struct tms*)sv_grow(ST(1), sizeof(struct tms));
+ CLEANUP:
+ SvCUR(ST(1)) = sizeof(struct tms);
+
+int
+umask()
+
+int
+uname()
+ CODE:
+ dSP;
+ struct utsname utsname;
+ sp--;
+ if (uname(&utsname) >= 0) {
+ EXTEND(sp, 5);
+ PUSHs(sv_2mortal(newSVpv(utsname.sysname, 0)));
+ PUSHs(sv_2mortal(newSVpv(utsname.nodename, 0)));
+ PUSHs(sv_2mortal(newSVpv(utsname.release, 0)));
+ PUSHs(sv_2mortal(newSVpv(utsname.version, 0)));
+ PUSHs(sv_2mortal(newSVpv(utsname.machine, 0)));
+ }
+ return sp - stack_base;
+
+int
+unlink()
+
+int
+utime()
+
+int
+wait()
+
+int
+waitpid(pid, statusp, options)
+ int pid
+ int &statusp
+ int options
+ OUTPUT:
+ statusp
+
+int
+write()
+
diff --git a/ext/posix/typemap b/ext/posix/typemap
new file mode 100644
index 0000000000..98d2135c6f
--- /dev/null
+++ b/ext/posix/typemap
@@ -0,0 +1,4 @@
+mode_t T_INT
+pid_t T_INT
+fd T_INT
+FILE * T_PTR
diff --git a/ext/typemap b/ext/typemap
index 29cd0513aa..8c9f48d7fc 100644
--- a/ext/typemap
+++ b/ext/typemap
@@ -23,219 +23,133 @@ Result T_U_CHAR
Boolean T_U_CHAR
double T_DOUBLE
-#
-#################################### XLIB SECTION
-#
-
-# basic X types
-Atom T_U_LONG
-Atom * T_OPAQUEPTR
-Bool T_INT
-KeyCode T_U_LONG
-Status T_INT
-Time T_U_LONG
-VisualID T_U_LONG
-XID T_U_LONG
-GC T_PTR
-Display * T_PTR
-Screen * T_PTR
-Visual * T_PTR
-XImage * T_PTR
-Region T_PTR
-
-# things that are XIDs
-Colormap T_U_LONG
-Cursor T_U_LONG
-Drawable T_U_LONG
-Font T_U_LONG
-GContext T_U_LONG
-KeySym T_U_LONG
-KeySym * T_OPAQUEPTR
-Pixmap T_U_LONG
-Pixmap * T_OPAQUEPTR
-Window T_U_LONG
-Window * T_OPAQUEPTR
-
-# X resource manager types
-XrmDatabase T_PTR
-XrmQuark T_INT
-XrmQuarkList T_OPAQUEPTR
-XrmName T_INT
-XrmNameList T_OPAQUEPTR
-XrmClass T_INT
-XrmClassList T_OPAQUEPTR
-XrmRepresentation T_INT
-XrmString T_STRING
-XrmBinding T_ENUM
-XrmBindingList T_OPAQUEPTR
-XrmOptionKind T_ENUM
-XrmSearchList T_OPAQUEPTR
-
-# context manager types
-XContext T_INT
-
-# Xlib data structures
-XArc * T_OPAQUEPTR
-XCharStruct T_OPAQUE
-XCharStruct * T_OPAQUEPTR
-XColor T_OPAQUE
-XColor * T_OPAQUEPTR
-XComposeStatus * T_OPAQUEPTR
-XEvent T_OPAQUE
-XEvent * T_OPAQUEPTR
-XFontStruct T_OPAQUE
-XFontStruct * T_PTR
-XGCValues * T_OPAQUEPTR
-XIconSize * T_OPAQUEPTR
-XKeyboardControl * T_OPAQUEPTR
-XKeyboardState T_OPAQUE
-XModifierKeymap * T_PTR
-XPoint T_OPAQUE
-XPoint * T_OPAQUEPTR
-XRectangle T_OPAQUE
-XRectangle * T_OPAQUEPTR
-XSegment * T_OPAQUEPTR
-XSetWindowAttributes * T_OPAQUEPTR
-XSizeHints T_OPAQUE
-XSizeHints * T_OPAQUEPTR
-XStandardColormap T_OPAQUE
-XStandardColormap * T_OPAQUEPTR
-XTimeCoord * T_OPAQUEPTR
-XVisualInfo T_OPAQUE
-XVisualInfo * T_OPAQUEPTR
-XWindowAttributes T_OPAQUE
-XWindowAttributes * T_OPAQUEPTR
-XWindowChanges * T_OPAQUEPTR
-XWMHints * T_OPAQUEPTR
-
-# these data types must be handled specially
-#XrmValue T_OPAQUE
-#XrmValue * T_OPAQUEPTR
-#XrmOptionDescList T_OPAQUEPTR
-#XClassHint T_OPAQUE
-#XClassHint * T_OPAQUEPTR
-#XHostAddress * T_OPAQUEPTR
-#XTextItem * T_OPAQUEPTR
-#XTextItem16 * T_OPAQUEPTR
-#XTextProperty T_OPAQUE
-#XTextProperty * T_OPAQUEPTR
-
-#
-#################################### PARCPLACE OI SECTION
-#
-
-# basic OI types
-OI_alignment T_ENUM
-OI_bevel_style T_ENUM
-OI_bool T_ENUM
-OI_charset T_ENUM
-OI_char_encode_type T_ENUM
-OI_configure_mask T_ENUM
-OI_drop_type T_ENUM
-OI_ef_char_chk_status T_ENUM
-OI_ef_entry_chk_status T_ENUM
-OI_ef_mode T_ENUM
-OI_enhance T_ENUM
-OI_gravity T_ENUM
-OI_gauge_ends T_ENUM
-OI_gauge_ticks T_ENUM
-OI_layout T_INT
-OI_menu_cell_type T_ENUM
-OI_mnemonic_style T_ENUM
-OI_model_type T_ENUM
-OI_mt_char_chk_status T_ENUM
-OI_mt_entry_chk_status T_ENUM
-OI_mt_mode T_ENUM
-OI_number T_SHORT
-OI_number * T_OPAQUEPTR
-OI_orient T_ENUM
-OI_pic_type T_ENUM
-OI_pic_pixel T_ENUM
-OI_psn_type T_ENUM
-OI_rm_db T_ENUM
-OI_sav_rst_typ T_ENUM
-OI_scroll_event T_ENUM
-OI_size_track T_ENUM
-OI_slider_current T_ENUM
-OI_slider_ends T_ENUM
-OI_slider_ticks T_ENUM
-OI_stat T_ENUM
-OI_state T_ENUM
-OI_wm_state T_ENUM
-PIXEL T_LONG
-
-# OI classes
-OI_abbr_menu * T_PTR
-OI_animate_item * T_PTR
-OI_app_window * T_PTR
-OI_base_text * T_PTR
-OI_box * T_PTR
-OI_button_menu * T_PTR
-OI_command_dialog_box * T_PTR
-OI_excl_menu * T_PTR
-OI_excl_check_menu * T_PTR
-OI_excl_rect_menu * T_PTR
-OI_basic_menu * T_PTR
-OI_class * T_PTR
-OI_connection * T_PTR
-OI_ctlr_1d * T_PTR
-OI_d_tech * T_PTR
-OI_d_tech ** T_OPAQUEPTR
-OI_dialog_box * T_PTR
-OI_display_1d * T_PTR
-OI_entry_field * T_PTR
-OI_error_dialog_box * T_PTR
-OI_excl_menu * T_PTR
-OI_file_dialog_box * T_PTR
-OI_gauge * T_PTR
-OI_glyph * T_PTR
-OI_help * T_PTR
-OI_info_dialog_box * T_PTR
-OI_menu * T_PTR
-OI_menu_cell * T_PTR
-OI_menu_cell ** T_OPAQUEPTR
-OI_menu_spec * T_PACKED
-OI_message_dialog_box * T_PTR
-OI_ms_dialog_box * T_PTR
-OI_multi_text * T_PTR
-OI_panner * T_PTR
-OI_pic_spec_mask * T_PTR
-OI_pic_spec_mask ** T_OPAQUEPTR
-OI_poly_menu * T_PTR
-OI_poly_check_menu * T_PTR
-OI_poly_rect_menu * T_PTR
-OI_prompt_dialog_box * T_PTR
-OI_question_dialog_box * T_PTR
-OI_scroll_bar * T_PTR
-OI_scroll_box * T_PTR
-OI_scroll_menu * T_PTR
-OI_scroll_text * T_PTR
-OI_select_dialog_box * T_PTR
-OI_separator * T_PTR
-OI_seq_entry_field * T_PTR
-OI_slider * T_PTR
-OI_static_text * T_PTR
-OI_translation_table * T_PTR
-OI_warn_dialog_box * T_PTR
-OI_work_dialog_box * T_PTR
-
-#
-#################################### XPM SECTION
-#
-XpmAttributes * T_PACKED
-XpmColorSymbol * T_PACKED
-XpmExtension * T_PACKED
-
-#
-#################################### DBM SECTION
-#
-
-datum T_DATUM
-gdatum T_GDATUM
-NDBM_File T_PTROBJ
-GDBM_File T_PTROBJ
-SDBM_File T_PTROBJ
-ODBM_File T_PTROBJ
-DB_File T_PTROBJ
-DBZ_File T_PTROBJ
-FATALFUNC T_OPAQUEPTR
+#############################################################################
+INPUT
+T_INT
+ $var = (int)SvIV($arg)
+T_ENUM
+ $var = ($type)SvIV($arg)
+T_U_INT
+ $var = (unsigned int)SvIV($arg)
+T_SHORT
+ $var = (short)SvIV($arg)
+T_U_SHORT
+ $var = (unsigned short)SvIV($arg)
+T_LONG
+ $var = (long)SvIV($arg)
+T_U_LONG
+ $var = (unsigned long)SvIV($arg)
+T_CHAR
+ $var = (char)*SvPV($arg,na)
+T_U_CHAR
+ $var = (unsigned char)SvIV($arg)
+T_FLOAT
+ $var = (float)SvNV($arg)
+T_DOUBLE
+ $var = SvNV($arg)
+T_STRING
+ $var = SvPV($arg,na)
+T_PTR
+ $var = ($type)(unsigned long)SvNV($arg)
+T_PTRREF
+ if (SvROK($arg))
+ $var = ($type)(unsigned long)SvNV((SV*)SvRV($arg));
+ else
+ croak(\"$var is not a reference\")
+T_PTROBJ
+ if (sv_isa($arg, \"${ntype}\"))
+ $var = ($type)(unsigned long)SvNV((SV*)SvRV($arg));
+ else
+ croak(\"$var is not of type ${ntype}\")
+T_PTRDESC
+ if (sv_isa($arg, \"${ntype}\")) {
+ ${type}_desc = (\U${type}_DESC\E*)(unsigned long)SvNV((SV*)SvRV($arg));
+ $var = ${type}_desc->ptr;
+ }
+ else
+ croak(\"$var is not of type ${ntype}\")
+T_REFREF
+ if (SvROK($arg))
+ $var = *($type)(unsigned long)SvNV((SV*)SvRV($arg));
+ else
+ croak(\"$var is not a reference\")
+T_REFOBJ
+ if (sv_isa($arg, \"${ntype}\"))
+ $var = *($type)(unsigned long)SvNV((SV*)SvRV($arg));
+ else
+ croak(\"$var is not of type ${ntype}\")
+T_OPAQUE
+ $var NOT IMPLEMENTED
+T_OPAQUEPTR
+ $var = ($type)SvPV($arg,na)
+T_PACKED
+ $var = XS_unpack_$ntype($arg)
+T_PACKEDARRAY
+ $var = XS_unpack_$ntype($arg)
+T_CALLBACK
+ $var = make_perl_cb_$type($arg)
+T_ARRAY
+ $var = $ntype(items -= $argoff);
+ U32 ix_$var = $argoff;
+ while (items--) {
+ DO_ARRAY_ELEM;
+ }
+#############################################################################
+OUTPUT
+T_INT
+ sv_setiv($arg, (I32)$var);
+T_ENUM
+ sv_setiv($arg, (I32)$var);
+T_U_INT
+ sv_setiv($arg, (I32)$var);
+T_SHORT
+ sv_setiv($arg, (I32)$var);
+T_U_SHORT
+ sv_setiv($arg, (I32)$var);
+T_LONG
+ sv_setiv($arg, (I32)$var);
+T_U_LONG
+ sv_setiv($arg, (I32)$var);
+T_CHAR
+ sv_setpvn($arg, (char *)&$var, 1);
+T_U_CHAR
+ sv_setiv($arg, (I32)$var);
+T_FLOAT
+ sv_setnv($arg, (double)$var);
+T_DOUBLE
+ sv_setnv($arg, $var);
+T_STRING
+ sv_setpv($arg, $var);
+T_PTR
+ sv_setnv($arg, (double)(unsigned long)$var);
+T_PTRREF
+ sv_setptrref($arg, $var);
+T_PTROBJ
+ sv_setptrobj($arg, $var, \"${ntype}\");
+T_PTRDESC
+ sv_setptrobj($arg, (void*)new\U${type}_DESC\E($var), \"${ntype}\");
+T_REFREF
+ sv_setrefref($arg, \"${ntype}\", XS_service_$ntype,
+ ($var ? (void*)new $ntype($var) : 0));
+T_REFOBJ
+ NOT IMPLEMENTED
+T_OPAQUE
+ sv_setpvn($arg, (char *)&$var, sizeof($var));
+T_OPAQUEPTR
+ sv_setpvn($arg, (char *)$var, sizeof(*$var)), XFree((char *)$var);
+T_PACKED
+ XS_pack_$ntype($arg, $var);
+T_PACKEDARRAY
+ XS_pack_$ntype($arg, $var, count_$ntype);
+T_DATAUNIT
+ sv_setpvn($arg, $var.chp(), $var.size());
+T_CALLBACK
+ sv_setpvn($arg, $var.context.value().chp(),
+ $var.context.value().size());
+T_ARRAY
+ ST_EXTEND($var.size);
+ for (U32 ix_$var = 0; ix_$var < $var.size; ix_$var++) {
+ ST(ix_$var) = sv_newmortal();
+ DO_ARRAY_ELEM
+ }
+ sp += $var.size - 1;
diff --git a/ext/typemap.oi b/ext/typemap.oi
new file mode 100644
index 0000000000..fc93718b93
--- /dev/null
+++ b/ext/typemap.oi
@@ -0,0 +1,99 @@
+#
+#################################### PARCPLACE OI SECTION
+#
+
+# basic OI types
+OI_alignment T_ENUM
+OI_bevel_style T_ENUM
+OI_bool T_ENUM
+OI_charset T_ENUM
+OI_char_encode_type T_ENUM
+OI_configure_mask T_ENUM
+OI_drop_type T_ENUM
+OI_ef_char_chk_status T_ENUM
+OI_ef_entry_chk_status T_ENUM
+OI_ef_mode T_ENUM
+OI_enhance T_ENUM
+OI_gravity T_ENUM
+OI_gauge_ends T_ENUM
+OI_gauge_ticks T_ENUM
+OI_layout T_INT
+OI_menu_cell_type T_ENUM
+OI_mnemonic_style T_ENUM
+OI_model_type T_ENUM
+OI_mt_char_chk_status T_ENUM
+OI_mt_entry_chk_status T_ENUM
+OI_mt_mode T_ENUM
+OI_number T_SHORT
+OI_number * T_OPAQUEPTR
+OI_orient T_ENUM
+OI_pic_type T_ENUM
+OI_pic_pixel T_ENUM
+OI_psn_type T_ENUM
+OI_rm_db T_ENUM
+OI_sav_rst_typ T_ENUM
+OI_scroll_event T_ENUM
+OI_size_track T_ENUM
+OI_slider_current T_ENUM
+OI_slider_ends T_ENUM
+OI_slider_ticks T_ENUM
+OI_stat T_ENUM
+OI_state T_ENUM
+OI_wm_state T_ENUM
+PIXEL T_LONG
+
+# OI classes
+OI_abbr_menu * T_PTR
+OI_animate_item * T_PTR
+OI_app_window * T_PTR
+OI_base_text * T_PTR
+OI_box * T_PTR
+OI_button_menu * T_PTR
+OI_command_dialog_box * T_PTR
+OI_excl_menu * T_PTR
+OI_excl_check_menu * T_PTR
+OI_excl_rect_menu * T_PTR
+OI_basic_menu * T_PTR
+OI_class * T_PTR
+OI_connection * T_PTR
+OI_ctlr_1d * T_PTR
+OI_d_tech * T_PTR
+OI_d_tech ** T_OPAQUEPTR
+OI_dialog_box * T_PTR
+OI_display_1d * T_PTR
+OI_entry_field * T_PTR
+OI_error_dialog_box * T_PTR
+OI_excl_menu * T_PTR
+OI_file_dialog_box * T_PTR
+OI_gauge * T_PTR
+OI_glyph * T_PTR
+OI_help * T_PTR
+OI_info_dialog_box * T_PTR
+OI_menu * T_PTR
+OI_menu_cell * T_PTR
+OI_menu_cell ** T_OPAQUEPTR
+OI_menu_spec * T_PACKED
+OI_message_dialog_box * T_PTR
+OI_ms_dialog_box * T_PTR
+OI_multi_text * T_PTR
+OI_panner * T_PTR
+OI_pic_spec_mask * T_PTR
+OI_pic_spec_mask ** T_OPAQUEPTR
+OI_poly_menu * T_PTR
+OI_poly_check_menu * T_PTR
+OI_poly_rect_menu * T_PTR
+OI_prompt_dialog_box * T_PTR
+OI_question_dialog_box * T_PTR
+OI_scroll_bar * T_PTR
+OI_scroll_box * T_PTR
+OI_scroll_menu * T_PTR
+OI_scroll_text * T_PTR
+OI_select_dialog_box * T_PTR
+OI_separator * T_PTR
+OI_seq_entry_field * T_PTR
+OI_slider * T_PTR
+OI_static_text * T_PTR
+OI_translation_table * T_PTR
+OI_warn_dialog_box * T_PTR
+OI_work_dialog_box * T_PTR
+
diff --git a/ext/typemap.xlib b/ext/typemap.xlib
new file mode 100644
index 0000000000..b04d13048a
--- /dev/null
+++ b/ext/typemap.xlib
@@ -0,0 +1,97 @@
+#
+#################################### XLIB SECTION
+#
+
+# basic X types
+Atom T_U_LONG
+Atom * T_OPAQUEPTR
+Bool T_INT
+KeyCode T_U_LONG
+Status T_INT
+Time T_U_LONG
+VisualID T_U_LONG
+XID T_U_LONG
+GC T_PTR
+Display * T_PTR
+Screen * T_PTR
+Visual * T_PTR
+XImage * T_PTR
+Region T_PTR
+
+# things that are XIDs
+Colormap T_U_LONG
+Cursor T_U_LONG
+Drawable T_U_LONG
+Font T_U_LONG
+GContext T_U_LONG
+KeySym T_U_LONG
+KeySym * T_OPAQUEPTR
+Pixmap T_U_LONG
+Pixmap * T_OPAQUEPTR
+Window T_U_LONG
+Window * T_OPAQUEPTR
+
+# X resource manager types
+XrmDatabase T_PTR
+XrmQuark T_INT
+XrmQuarkList T_OPAQUEPTR
+XrmName T_INT
+XrmNameList T_OPAQUEPTR
+XrmClass T_INT
+XrmClassList T_OPAQUEPTR
+XrmRepresentation T_INT
+XrmString T_STRING
+XrmBinding T_ENUM
+XrmBindingList T_OPAQUEPTR
+XrmOptionKind T_ENUM
+XrmSearchList T_OPAQUEPTR
+
+# context manager types
+XContext T_INT
+
+# Xlib data structures
+XArc * T_OPAQUEPTR
+XCharStruct T_OPAQUE
+XCharStruct * T_OPAQUEPTR
+XColor T_OPAQUE
+XColor * T_OPAQUEPTR
+XComposeStatus * T_OPAQUEPTR
+XEvent T_OPAQUE
+XEvent * T_OPAQUEPTR
+XFontStruct T_OPAQUE
+XFontStruct * T_PTR
+XGCValues * T_OPAQUEPTR
+XIconSize * T_OPAQUEPTR
+XKeyboardControl * T_OPAQUEPTR
+XKeyboardState T_OPAQUE
+XModifierKeymap * T_PTR
+XPoint T_OPAQUE
+XPoint * T_OPAQUEPTR
+XRectangle T_OPAQUE
+XRectangle * T_OPAQUEPTR
+XSegment * T_OPAQUEPTR
+XSetWindowAttributes * T_OPAQUEPTR
+XSizeHints T_OPAQUE
+XSizeHints * T_OPAQUEPTR
+XStandardColormap T_OPAQUE
+XStandardColormap * T_OPAQUEPTR
+XTimeCoord * T_OPAQUEPTR
+XVisualInfo T_OPAQUE
+XVisualInfo * T_OPAQUEPTR
+XWindowAttributes T_OPAQUE
+XWindowAttributes * T_OPAQUEPTR
+XWindowChanges * T_OPAQUEPTR
+XWMHints * T_OPAQUEPTR
+
+# these data types must be handled specially
+#XrmValue T_OPAQUE
+#XrmValue * T_OPAQUEPTR
+#XrmOptionDescList T_OPAQUEPTR
+#XClassHint T_OPAQUE
+#XClassHint * T_OPAQUEPTR
+#XHostAddress * T_OPAQUEPTR
+#XTextItem * T_OPAQUEPTR
+#XTextItem16 * T_OPAQUEPTR
+#XTextProperty T_OPAQUE
+#XTextProperty * T_OPAQUEPTR
+
diff --git a/ext/typemap.xpm b/ext/typemap.xpm
new file mode 100644
index 0000000000..d1312767f5
--- /dev/null
+++ b/ext/typemap.xpm
@@ -0,0 +1,7 @@
+#
+#################################### XPM SECTION
+#
+XpmAttributes * T_PACKED
+XpmColorSymbol * T_PACKED
+XpmExtension * T_PACKED
+
diff --git a/ext/xsubpp b/ext/xsubpp
index e7a710be2a..d2be4f5619 100755
--- a/ext/xsubpp
+++ b/ext/xsubpp
@@ -1,177 +1,78 @@
-#!/usr/bin/perl
+#!./perl
# $Header$
-$usage = "Usage: xsubpp [-a] [-s] [-c] typemap file.xs\n";
-die $usage unless (@ARGV >= 2 && @ARGV <= 6);
+$usage = "Usage: xsubpp [-ansi] [-C++] [-except] [-tm typemap] file.xs\n";
-SWITCH: while ($ARGV[0] =~ /^-/) {
+SWITCH: while ($ARGV[0] =~ s/^-//) {
$flag = shift @ARGV;
- $aflag = 1, next SWITCH if $flag =~ /^-a$/;
- $spat = $1, next SWITCH if $flag =~ /^-s(.*)$/;
- $cflag = 1, next SWITCH if $flag =~ /^-c$/;
- $eflag = 1, next SWITCH if $flag =~ /^-e$/;
+ $ansiflag = 1, next SWITCH if $flag eq 'ansi';
+ $spat = shift, next SWITCH if $flag eq 's';
+ $cplusplus = 1, next SWITCH if $flag eq 'C++';
+ $except = 1, next SWITCH if $flag eq 'except';
+ push(@tm,shift), next SWITCH if $flag eq 'typemap';
die $usage;
}
+@ARGV == 1 or die $usage;
+chop($pwd = `pwd`);
+($dir, $filename) = @ARGV[0] =~ m#(.*)/(.*)#
+ or ($dir, $filename) = ('.', $ARGV[0]);
+chdir($dir);
$typemap = shift @ARGV;
-open(TYPEMAP, $typemap) || die "cannot open $typemap\n";
-while (<TYPEMAP>) {
- next if /^\s*$/ || /^#/;
- chop;
- ($typename, $kind) = split(/\t+/, $_, 2);
- $type_kind{$typename} = $kind;
+foreach $typemap (@tm) {
+ die "Can't find $typemap in $pwd\n" unless -r $typemap;
}
-close(TYPEMAP);
-
-%input_expr = (JUNK, split(/\n(T_\w*)\s*\n/, <<'T_END'));
-
-T_INT
- $var = (int)SvIV($arg)
-T_ENUM
- $var = ($type)SvIV($arg)
-T_U_INT
- $var = (unsigned int)SvIV($arg)
-T_SHORT
- $var = (short)SvIV($arg)
-T_U_SHORT
- $var = (unsigned short)SvIV($arg)
-T_LONG
- $var = (long)SvIV($arg)
-T_U_LONG
- $var = (unsigned long)SvIV($arg)
-T_CHAR
- $var = (char)*SvPV($arg,na)
-T_U_CHAR
- $var = (unsigned char)SvIV($arg)
-T_FLOAT
- $var = (float)SvNV($arg)
-T_DOUBLE
- $var = SvNV($arg)
-T_STRING
- $var = SvPV($arg,na)
-T_PTR
- $var = ($type)(unsigned long)SvNV($arg)
-T_PTRREF
- if (SvROK($arg))
- $var = ($type)(unsigned long)SvNV((SV*)SvRV($arg));
- else
- croak(\"$var is not a reference\")
-T_PTROBJ
- if (sv_isa($arg, \"${ntype}\"))
- $var = ($type)(unsigned long)SvNV((SV*)SvRV($arg));
- else
- croak(\"$var is not of type ${ntype}\")
-T_PTRDESC
- if (sv_isa($arg, \"${ntype}\")) {
- ${type}_desc = (\U${type}_DESC\E*)(unsigned long)SvNV((SV*)SvRV($arg));
- $var = ${type}_desc->ptr;
+unshift @tm, qw(../../../typemap ../../typemap ../typemap typemap);
+foreach $typemap (@tm) {
+ open(TYPEMAP, $typemap) || next;
+ $mode = Typemap;
+ $current = \$junk;
+ while (<TYPEMAP>) {
+ next if /^#/;
+ if (/^INPUT\s*$/) { $mode = Input, next }
+ if (/^OUTPUT\s*$/) { $mode = Output, next }
+ if (/^TYPEMAP\s*$/) { $mode = Typemap, next }
+ if ($mode eq Typemap) {
+ chop;
+ ($typename, $kind) = split(/\t+/, $_, 2);
+ $type_kind{$typename} = $kind if $kind ne '';
}
- else
- croak(\"$var is not of type ${ntype}\")
-T_REFREF
- if (SvROK($arg))
- $var = *($type)(unsigned long)SvNV((SV*)SvRV($arg));
- else
- croak(\"$var is not a reference\")
-T_REFOBJ
- if (sv_isa($arg, \"${ntype}\"))
- $var = *($type)(unsigned long)SvNV((SV*)SvRV($arg));
- else
- croak(\"$var is not of type ${ntype}\")
-T_OPAQUE
- $var NOT IMPLEMENTED
-T_OPAQUEPTR
- $var = ($type)SvPV($arg,na)
-T_PACKED
- $var = XS_unpack_$ntype($arg)
-T_PACKEDARRAY
- $var = XS_unpack_$ntype($arg)
-T_CALLBACK
- $var = make_perl_cb_$type($arg)
-T_ARRAY
- $var = $ntype(items -= $argoff);
- U32 ix_$var = $argoff;
- while (items--) {
- DO_ARRAY_ELEM;
+ elsif ($mode eq Input) {
+ if (/^\s/) {
+ $$current .= $_;
+ }
+ else {
+ s/\s*$//;
+# $input_expr{$_} = '';
+ $current = \$input_expr{$_};
+ }
}
-T_DATUM
- $var.dptr = SvPV($arg, $var.dsize);
-T_GDATUM
- UNIMPLEMENTED
-T_PLACEHOLDER
-T_END
-
-$* = 1; %output_expr = (JUNK, split(/^(T_\w*)\s*\n/, <<'T_END')); $* = 0;
-T_INT
- sv_setiv($arg, (I32)$var);
-T_ENUM
- sv_setiv($arg, (I32)$var);
-T_U_INT
- sv_setiv($arg, (I32)$var);
-T_SHORT
- sv_setiv($arg, (I32)$var);
-T_U_SHORT
- sv_setiv($arg, (I32)$var);
-T_LONG
- sv_setiv($arg, (I32)$var);
-T_U_LONG
- sv_setiv($arg, (I32)$var);
-T_CHAR
- sv_setpvn($arg, (char *)&$var, 1);
-T_U_CHAR
- sv_setiv($arg, (I32)$var);
-T_FLOAT
- sv_setnv($arg, (double)$var);
-T_DOUBLE
- sv_setnv($arg, $var);
-T_STRING
- sv_setpv($arg, $var);
-T_PTR
- sv_setnv($arg, (double)(unsigned long)$var);
-T_PTRREF
- sv_setptrref($arg, $var);
-T_PTROBJ
- sv_setptrobj($arg, $var, \"${ntype}\");
-T_PTRDESC
- sv_setptrobj($arg, (void*)new\U${type}_DESC\E($var), \"${ntype}\");
-T_REFREF
- sv_setrefref($arg, \"${ntype}\", XS_service_$ntype,
- ($var ? (void*)new $ntype($var) : 0));
-T_REFOBJ
- NOT IMPLEMENTED
-T_OPAQUE
- sv_setpvn($arg, (char *)&$var, sizeof($var));
-T_OPAQUEPTR
- sv_setpvn($arg, (char *)$var, sizeof(*$var)), XFree((char *)$var);
-T_PACKED
- XS_pack_$ntype($arg, $var);
-T_PACKEDARRAY
- XS_pack_$ntype($arg, $var, count_$ntype);
-T_DATAUNIT
- sv_setpvn($arg, $var.chp(), $var.size());
-T_CALLBACK
- sv_setpvn($arg, $var.context.value().chp(),
- $var.context.value().size());
-T_ARRAY
- ST_EXTEND($var.size);
- for (U32 ix_$var = 0; ix_$var < $var.size; ix_$var++) {
- ST(ix_$var) = sv_mortalcopy(&sv_undef);
- DO_ARRAY_ELEM
+ else {
+ if (/^\s/) {
+ $$current .= $_;
+ }
+ else {
+ s/\s*$//;
+# $output_expr{$_} = '';
+ $current = \$output_expr{$_};
+ }
}
- sp += $var.size - 1;
-T_DATUM
- sv_setpvn($arg, $var.dptr, $var.dsize);
-T_GDATUM
- sv_usepvn($arg, $var.dptr, $var.dsize);
-T_END
+ }
+ close(TYPEMAP);
+}
-$uvfile = shift @ARGV;
-open(F, $uvfile) || die "cannot open $uvfile\n";
+foreach $key (keys %input_expr) {
+ $input_expr{$key} =~ s/\n+$//;
+}
-if ($eflag) {
- print qq|#include "cfm/basic.h"\n|;
+sub Q {
+ local $text = shift;
+ $text =~ tr/#//d;
+ $text;
}
+open(F, $filename) || die "cannot open $filename\n";
+
while (<F>) {
last if ($Module, $foo, $Package, $foo1, $Prefix) =
/^MODULE\s*=\s*(\w+)(\s+PACKAGE\s*=\s*(\w+))?(\s+PREFIX\s*=\s*(.+))?$/;
@@ -196,7 +97,7 @@ while (<F>) {
$Package .= "::" if defined $Package && $Package ne "";
next;
}
- split(/[\t ]*\n/);
+ @line = split(/[\t ]*\n/);
# initialize info arrays
undef(%args_match);
@@ -208,12 +109,12 @@ while (<F>) {
undef($elipsis);
# extract return type, function name and arguments
- $ret_type = shift(@_);
+ $ret_type = shift(@line);
if ($ret_type =~ /^static\s+(.*)$/) {
$static = 1;
$ret_type = $1;
}
- $func_header = shift(@_);
+ $func_header = shift(@line);
($func_name, $orig_args) = $func_header =~ /^([\w:]+)\s*\((.*)\)$/;
if ($func_name =~ /(.*)::(.*)/) {
$class = $1;
@@ -254,39 +155,47 @@ while (<F>) {
@args_match{@args} = 1..@args;
# print function header
- print <<"EOF" if $aflag;
-static int
-XS_${Pack}_$func_name(int, int sp, int items)
+ if ($ansiflag) {
+ print Q<<"EOF";
+#static int
+#XS_${Pack}_$func_name(int, int ax, int items)
EOF
- print <<"EOF" if !$aflag;
-static int
-XS_${Pack}_$func_name(ix, sp, items)
-register int ix;
-register int sp;
-register int items;
-EOF
- print <<"EOF" if $elipsis;
-{
- if (items < $min_args) {
- croak("Usage: $pname($orig_args)");
- }
+ }
+ else {
+ print Q<<"EOF";
+#static int
+#XS_${Pack}_$func_name(ix, ax, items)
+#register int ix;
+#register int ax;
+#register int items;
EOF
- print <<"EOF" if !$elipsis;
-{
- if (items < $min_args || items > $num_args) {
- croak("Usage: $pname($orig_args)");
- }
+ }
+ if ($elipsis) {
+ $cond = qq(items < $min_args);
+ }
+ elsif ($min_args == $num_args) {
+ $cond = qq(items != $min_args);
+ }
+ else {
+ $cond = qq(items < $min_args || items > $num_args);
+ }
+
+print Q<<"EOF";
+#{
+# if ($cond) {
+# croak("Usage: $pname($orig_args)");
+# }
EOF
# Now do a block of some sort.
$condnum = 0;
-if (!@_) {
- @_ = "CLEANUP:";
+if (!@line) {
+ @line = "CLEANUP:";
}
-while (@_) {
+while (@line) {
if ($_[0] =~ s/^\s*CASE\s*:\s*//) {
- $cond = shift(@_);
+ $cond = shift(@line);
if ($condnum == 0) {
print " if ($cond)\n";
}
@@ -299,18 +208,24 @@ while (@_) {
$condnum++;
}
- print <<"EOF" if $eflag;
- TRY {
+ if ($except) {
+ print Q<<"EOF";
+# char errbuf[1024];
+# *errbuf = '\0';
+# TRY {
EOF
- print <<"EOF" if !$eflag;
- {
+ }
+ else {
+ print Q<<"EOF";
+# {
EOF
+ }
# do initialization of input variables
$thisdone = 0;
$retvaldone = 0;
$deferred = "";
- while ($_ = shift(@_)) {
+ while ($_ = shift(@line)) {
last if /^\s*NOT_IMPLEMENTED_YET/;
last if /^\s*(CODE|OUTPUT|CLEANUP|CASE)\s*:/;
($var_type, $var_name, $var_init) =
@@ -359,7 +274,7 @@ EOF
}
print $deferred;
if (/^\s*CODE:/) {
- while ($_ = shift(@_)) {
+ while ($_ = shift(@line)) {
last if /^\s*(OUTPUT|CLEANUP|CASE)\s*:/;
print "$_\n";
}
@@ -384,7 +299,7 @@ EOF
# do output variables
if (/^\s*OUTPUT\s*:/) {
- while ($_ = shift(@_)) {
+ while ($_ = shift(@line)) {
last if /^\s*CLEANUP\s*:/;
s/^\s+//;
($outarg, $outcode) = split(/\t+/);
@@ -401,43 +316,49 @@ EOF
}
# do cleanup
if (/^\s*CLEANUP\s*:/) {
- while ($_ = shift(@_)) {
+ while ($_ = shift(@line)) {
last if /^\s*CASE\s*:/;
print "$_\n";
}
}
# print function trailer
- print <<EOF if $eflag;
- }
- BEGHANDLERS
- CATCHALL
- croak("%s: %s\\tpropagated", Xname, Xreason);
- ENDHANDLERS
+ if ($except) {
+ print Q<<EOF;
+# }
+# BEGHANDLERS
+# CATCHALL
+# sprintf(errbuf, "%s: %s\\tpropagated", Xname, Xreason);
+# ENDHANDLERS
+# if (errbuf[0])
+# croak(errbuf);
EOF
- print <<EOF if !$eflag;
- }
+ }
+ else {
+ print Q<<EOF;
+# }
EOF
+ }
if (/^\s*CASE\s*:/) {
- unshift(@_, $_);
+ unshift(@line, $_);
}
}
- print <<EOF;
- return sp;
-}
-
+ print Q<<EOF;
+# return ax;
+#}
+#
EOF
}
# print initialization routine
-print qq/extern "C"\n/ if $cflag;
-print <<"EOF";
-int init_$Module(ix,sp,items)
-int ix;
-int sp;
-int items;
-{
- char* file = __FILE__;
-
+print qq/extern "C"\n/ if $cplusplus;
+print Q<<"EOF";
+#int boot_$Module(ix,ax,items)
+#int ix;
+#int ax;
+#int items;
+#{
+# char* file = __FILE__;
+#
EOF
for (@Func_name) {
@@ -453,18 +374,23 @@ sub output_init {
eval qq/print " $init\\\n"/;
}
+sub blurt { warn @_; $errors++ }
+
sub generate_init {
local($type, $num, $var) = @_;
local($arg) = "ST($num)";
local($argoff) = $num - 1;
local($ntype);
+ local($tk);
- die "$type not in typemap" if !defined($type_kind{$type});
+ blurt("$type not in typemap"), return unless defined($type_kind{$type});
($ntype = $type) =~ s/\s*\*/Ptr/g;
$subtype = $ntype;
$subtype =~ s/Ptr$//;
$subtype =~ s/Array$//;
- $expr = $input_expr{$type_kind{$type}};
+ $tk = $type_kind{$type};
+ $tk =~ s/OBJ$/REF/ if $func_name =~ /DESTROY$/;
+ $expr = $input_expr{$tk};
if ($expr =~ /DO_ARRAY_ELEM/) {
$subexpr = $input_expr{$type_kind{$subtype}};
$subexpr =~ s/ntype/subtype/g;
@@ -496,7 +422,8 @@ sub generate_output {
if ($type =~ /^array\(([^,]*),(.*)\)/) {
print "\tsv_setpvn($arg, (char *)$var, $2 * sizeof($1)), XFree((char *)$var);\n";
} else {
- die "$type not in typemap" if !defined($type_kind{$type});
+ blurt("$type not in typemap"), return
+ unless defined($type_kind{$type});
($ntype = $type) =~ s/\s*\*/Ptr/g;
$ntype =~ s/\(\)//g;
$subtype = $ntype;
@@ -512,7 +439,7 @@ sub generate_output {
$expr =~ s/DO_ARRAY_ELEM\n/$subexpr/;
}
elsif ($arg eq 'ST(0)') {
- print "\tST(0) = sv_mortalcopy(&sv_undef);\n";
+ print "\tST(0) = sv_newmortal();\n";
}
eval "print qq\f$expr\f";
}
@@ -527,3 +454,5 @@ sub map_type {
return $type;
}
}
+
+exit $errors;
View Lorry Controller Status