[prev in list] [next in list] [prev in thread] [next in thread]
List: intermezzo-cvs
Subject: CVS: intermezzo/QuadInt Changes,NONE,1.1 MANIFEST,NONE,1.1 Makefile.PL,NONE,1.1 QuadInt.pm,NONE,1.1
From: Shirish Hemant Phatak <shirish () users ! sourceforge ! net>
Date: 2001-09-29 21:23:19
[Download RAW message or body]
Update of /cvsroot/intermezzo/intermezzo/QuadInt
In directory usw-pr-cvs1:/tmp/cvs-serv21438/QuadInt
Added Files:
Changes MANIFEST Makefile.PL QuadInt.pm QuadInt.xs test.pl
typemap
Log Message:
Module for handling 64 bit unsigned int types in perl. This module provides
an quad type with overloaded comparision, '+' and '-' operations. Also
provided is an overloaded stringify that prints quads in the form
"high << 32 + low" (maybe we should print the actual text representation?).
This is required for Phil's kml truncation patches which create 64 bit
offsets.
--- NEW FILE ---
Revision history for Perl extension Math::QuadInt.
0.01 Sat Sep 29 14:16:17 2001
- original version; created by h2xs 1.20 with options
-Ax -n Math::QuadInt
--- NEW FILE ---
Changes
MANIFEST
Makefile.PL
QuadInt.pm
QuadInt.xs
test.pl
--- NEW FILE ---
use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
'NAME' => 'Math::QuadInt',
'VERSION_FROM' => 'QuadInt.pm', # finds $VERSION
'PREREQ_PM' => {}, # e.g., Module::Name => 1.1
'LIBS' => [''], # e.g., '-lm'
'DEFINE' => '', # e.g., '-DHAVE_SOMETHING'
'INC' => '', # e.g., '-I/usr/include/other'
);
--- NEW FILE ---
package Math::QuadInt;
require 5.005_62;
use strict;
use warnings;
use integer;
require Exporter;
require DynaLoader;
our @ISA = qw(Exporter DynaLoader);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
# This allows declaration use Math::QuadInt ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(
add_array
add_quad
sub_array
sub_quad
qadd
qsub
qstr
) ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw(
);
our $VERSION = '0.01';
bootstrap Math::QuadInt $VERSION;
use overload
'+' => sub { Math::QuadInt::add_quad($_[0],$_[1])},
'-' => sub { if ($_[2]) {
Math::QuadInt::sub_quad($_[1],$_[0])
} else {
Math::QuadInt::sub_quad($_[0],$_[1])
}
},
'>' => sub { return (Math::QuadInt::qcmp($_[0],$_[1]) > 0)},
'>=' => sub { return (Math::QuadInt::qcmp($_[0],$_[1]) >= 0)},
'<' => sub { return (Math::QuadInt::qcmp($_[0],$_[1]) < 0)},
'<=' => sub { return (Math::QuadInt::qcmp($_[0],$_[1]) <= 0)},
'==' => sub { return (Math::QuadInt::qcmp($_[0],$_[1]) == 0)},
'!=' => sub { return (Math::QuadInt::qcmp($_[0],$_[1]) != 0)},
qw(
"" qstr
);
sub qadd ($$) {
my ($quad,$high,$low) = shift;
print $quad;
print $high;
die "qadd requires at least two parameters\n" unless $high;
return Math::QuadInt::add_array($quad,$high,$low) if (defined $low);
return Math::QuadInt::add_quad($quad, $high);
}
sub qsub ($$) {
my ($quad,$high,$low) = shift;
die "qsub requires at least two parameters\n" unless $high;
return Math::QuadInt::sub_array($quad,$high,$low) if (defined $low);
return Math::QuadInt::sub_quad($quad, $high);
}
sub qstr ($) {
my $quad = shift;
my ($high,$low) = $quad->toArray();
return sprintf("%u << 32 + %u", $high, $low);
}
# Preloaded methods go here.
1;
__END__
=head1 NAME
Math::QuadInt - Perl extension for 64 bit artithmetic on arrays
=head1 SYNOPSIS
use Math::QuadInt;
$quad= new Math::QuadInt ($high,$low);
$quad2= new Math::QuadInt ($high,$low);
$quad3 = $quad->qadd($high,$low);
#or
$quad3 = $quad->qadd($quad2);
$quad4 = $quad->qsub($high,$low);
# or
$quad4 = $quad->qsub($quad2);
($high,$low) = $quad->toArray();
# not yet...but soon!
$quad5 = $quad + $quad2;
$quad6 = $quad - $quad2;
($high,$low) = $quad;
=head1 DESCRIPTION
This modules provides 64 bit arithmetic using the native 64 bit int type.
It uses two element integer arrays mapped onto the underlying 64 bit datatype.
=head2 EXPORT
None by default.
=head1 AUTHOR
A. U. Thor, a.u.thor@a.galaxy.far.far.away
=head1 SEE ALSO
perl(1).
=cut
--- NEW FILE ---
#include <inttypes.h>
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
typedef uint64_t *Math__QuadInt;
MODULE = Math::QuadInt PACKAGE = Math::QuadInt
Math::QuadInt
new (high,low)
uint32_t high
uint32_t low
CODE:
RETVAL=(uint64_t *)safemalloc(sizeof(uint64_t));
*RETVAL= ((uint64_t)high << 32) + (uint64_t) low;
OUTPUT:
RETVAL
Math::QuadInt
add_array (quad, high, low)
Math::QuadInt quad
uint32_t high
uint32_t low
CODE:
RETVAL=(uint64_t *)safemalloc(sizeof(uint64_t));
*RETVAL= *quad + ((uint64_t)high << 32) + (uint64_t) low;
OUTPUT:
RETVAL
Math::QuadInt
sub_array (quad, high, low)
Math::QuadInt quad
uint32_t high
uint32_t low
CODE:
RETVAL=(uint64_t *)safemalloc(sizeof(uint64_t));
*RETVAL= *quad - ((uint64_t)high << 32) - (uint64_t) low;
OUTPUT:
RETVAL
Math::QuadInt
add_quad (quad, quad1)
Math::QuadInt quad
Math::QuadInt quad1
CODE:
RETVAL=(uint64_t *)safemalloc(sizeof(uint64_t));
*RETVAL= *quad + *quad1;
OUTPUT:
RETVAL
Math::QuadInt
sub_quad (quad, quad1)
Math::QuadInt quad
Math::QuadInt quad1
CODE:
RETVAL=(uint64_t *)safemalloc(sizeof(uint64_t));
*RETVAL= *quad - *quad1;
OUTPUT:
RETVAL
int
qcmp (quad, quad1)
Math::QuadInt quad
Math::QuadInt quad1
CODE:
if (*quad > *quad1)
RETVAL=1;
else if (*quad < *quad1)
RETVAL=-1;
else
RETVAL=0;
OUTPUT:
RETVAL
void
toArray (quad)
Math::QuadInt quad
PPCODE:
if (GIMME != G_ARRAY)
croak("rs_log_sig must be called in an array context\n");
{ SV *sv;
sv=sv_2mortal(newSViv((int32_t) (*quad >> 32)));
XPUSHs(sv);
sv=sv_2mortal(newSViv((int32_t) (*quad & 0xffffffff)));
XPUSHs(sv);
}
void
DESTROY(quad)
Math::QuadInt quad;
CODE:
free(quad);
--- NEW FILE ---
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
######################### We start with some black magic to print on failure.
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
BEGIN { $| = 1; print "1..1\n"; }
END {print "not ok 1\n" unless $loaded;}
use Math::QuadInt;
$loaded = 1;
print "ok 1\n";
######################### End of black magic.
# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
$quad1 = Math::QuadInt::new(1, 1023);
$quad2 = Math::QuadInt::new (2, 20);
# basic comparision tests
if ($quad1 < $quad1)
{
print "not ok 2\n";
} else {
print "ok 2\n";
}
if ($quad1 == $quad2)
{
print "not ok 3\n";
} else {
print "ok 3\n";
}
if ($quad2 == $quad1)
{
print "not ok 4\n";
} else {
print "ok 4\n";
}
if ($quad1 >= $quad2)
{
print "not ok 5\n";
} else {
print "ok 5\n";
}
if ($quad1 > $quad2)
{
print "not ok 6\n";
} else {
print "ok 6\n";
}
if ($quad2 <= $quad1)
{
print "not ok 7\n";
} else {
print "ok 7\n";
}
if ($quad1 != $quad1)
{
print "not ok 8\n";
} else {
print "ok 8\n";
}
if ($quad2 != $quad1)
{
print "ok 9\n";
} else {
print "not ok 9\n";
}
if ($quad1 != $quad2)
{
print "ok 10\n";
} else {
print "not ok 10\n";
}
if ($quad1 == $quad1)
{
print "ok 11\n";
} else {
print "not ok 11\n";
}
if ($quad1 <= $quad1)
{
print "ok 12\n";
} else {
print "not ok 12\n";
}
if ($quad1 >= $quad1)
{
print "ok 13\n";
} else {
print "not ok 13\n";
}
if ($quad1 <= $quad2)
{
print "ok 14\n";
} else {
print "not ok 14\n";
}
if ($quad2 >= $quad1)
{
print "ok 15\n";
} else {
print "not ok 15\n";
}
if ($quad2 > $quad1)
{
print "ok 16\n";
} else {
print "not ok 16\n";
}
if ($quad1 < $quad2)
{
print "ok 17\n";
} else {
print "not ok 17\n";
}
# FIXME design more tests
print $quad1." ".$quad2;
$quad3 = $quad2 - $quad1;
print "quad3=".$quad3 . "\n";
$quad1 = $quad1->sub_array(0,1);
$quad2 = $quad2->add_array(20, 0xffffffff);
#print Math::QuadInt::qstr($quad1->qadd($quad2));
print $quad1->qstr()."\n";
print $quad2->qstr()."\n";
print $quad1;
--- NEW FILE ---
int32_t T_IV
uint32_t T_IV
Math::QuadInt T_PTROBJ
_______________________________________________
intermezzo-commit mailing list
intermezzo-commit@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/intermezzo-commit
[prev in list] [next in list] [prev in thread] [next in thread]
Configure |
About |
News |
Add a list |
Sponsored by KoreLogic