kstock@isfrance.encore.fr (Kevin Stock) (01/25/91)
Archive-Name: iperl/part1
I guess I must be cracking up. I've been trying to learn how to use
the usersubs stuff in Perl, and also how to program in Intercal.
Anyway, I ended up combining the two!
The following shar file is an instant mix package (just add Perl) for
Iperl, which is Perl plus the Intercal operators. There's even a
manual page - what more could you want?
#!/bin/sh
# This is a shell archive (produced by shar 3.49)
# To extract the files from this archive, save it to a file, remove
# everything above the "!/bin/sh" line above, and type "sh file_name".
#
# made 01/16/1991 08:40 UTC by kstock@mmcompta
# Source directory /usr/soft/public/perl/usub_ical
#
# existing files will NOT be overwritten unless -c is specified
#
# This shar contains:
# length mode name
# ------ ---------- ------------------------------------------
# 725 -rw-r--r-- README
# 523 -rw-r--r-- Makefile
# 3330 -rw-r--r-- ical.mus
# 1664 -rw-r--r-- iperl.1
# 152 -rwxr-xr-x iperlsh
# 472 -rwxr-xr-x op.ical
# 252 -rw-r--r-- usersub.c
#
# ============= README ==============
if test -f 'README' -a X"$1" != X"-c"; then
echo 'x - skipping README (File already exists)'
else
echo 'x - extracting README (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'README' &&
I think this belongs somewhere alongside such films as "Abbot and
Costello meet Frankenstein's Monster". But, here it is anyway ...
X
X PERL MEETS INTERCAL.
X
In this posting, you will find the usersubs stuff to add Intercal
functions to Perl. Unshar it somewhere (/dev/null would probably
do), and run make. (You may need to alter SRC in the Makefile).
X
The resulting binary, iperl, will work just like perl with the
addition of the following Intercal functions:
X
X and16 and16 mingle
X or16 or16 select
X xor16 xor16
X
The test file, op.ical, will run tests to ensure that the functions
work. This may be done using "make test".
X
The program iperlsh just reads in perl expressions (one per line) and
evaluates them.
X
X Kevin.
SHAR_EOF
chmod 0644 README ||
echo 'restore of README failed'
Wc_c="`wc -c < 'README'`"
test 725 -eq "$Wc_c" ||
echo 'README: original size 725, current size' "$Wc_c"
fi
# ============= Makefile ==============
if test -f 'Makefile' -a X"$1" != X"-c"; then
echo 'x - skipping Makefile (File already exists)'
else
echo 'x - extracting Makefile (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'Makefile' &&
SRC = /usr/local/src/perl
GLOBINCS =
LOCINCS =
LIBS =
X
iperl: $(SRC)/uperl.o usersub.o ical.o
X cc $(SRC)/uperl.o usersub.o ical.o $(LIBS) -lm -o iperl
X
usersub.o: usersub.c
X cc -c -I$(SRC) $(GLOBINCS) -DDEBUGGING -g usersub.c
X
ical.o: ical.c
X cc -c -I$(SRC) $(GLOBINCS) -DDEBUGGING -g ical.c
X
ical.c: $(SRC)/usub/mus ical.mus
X $(SRC)/usub/mus ical.mus >ical.c
X
test: iperl op.ical
X ./iperl op.ical
X
install:
X @echo "If you want to install this, you need to contact a phrenologist"
X @echo "(i.e. get your head examined!)"
SHAR_EOF
chmod 0644 Makefile ||
echo 'restore of Makefile failed'
Wc_c="`wc -c < 'Makefile'`"
test 523 -eq "$Wc_c" ||
echo 'Makefile: original size 523, current size' "$Wc_c"
fi
# ============= ical.mus ==============
if test -f 'ical.mus' -a X"$1" != X"-c"; then
echo 'x - skipping ical.mus (File already exists)'
else
echo 'x - extracting ical.mus (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'ical.mus' &&
/* $Header: ical.mus,v 3.0.1.1 90/08/09 04:05:21 lwall Locked $
X */
X
#include "EXTERN.h"
#include "perl.h"
extern int wantarray;
X
char *savestr();
X
static enum uservars {
X UV_dummy,
};
X
static enum usersubs {
X US_and16,
X US_or16,
X US_xor16,
X US_and32,
X US_or32,
X US_xor32,
X US_select,
X US_mingle,
};
X
unsigned short and16(), or16(), xor16();
unsigned long and32(), or32(), xor32();
unsigned int select(), mingle();
X
static int usersub();
static int userset();
static int userval();
X
int
init_ical()
{
X struct ufuncs uf;
X char *filename = "ical.c";
X
X uf.uf_set = userset;
X uf.uf_val = userval;
X
#define MAGICVAR(name, ix) uf.uf_index = ix, magicname(name, &uf, sizeof uf)
X
X make_usub("and16", US_and16, usersub, filename);
X make_usub("or16", US_or16, usersub, filename);
X make_usub("xor16", US_xor16, usersub, filename);
X make_usub("and32", US_and32, usersub, filename);
X make_usub("or32", US_or32, usersub, filename);
X make_usub("xor32", US_xor32, usersub, filename);
X make_usub("select", US_select, usersub, filename);
X make_usub("mingle", US_mingle, usersub, filename);
};
X
static int
usersub(ix, sp, items)
int ix;
register int sp;
register int items;
{
X STR **st = stack->ary_array + sp;
X register int i;
X register char *tmps;
X register STR *Str; /* used in str_get and str_gnum macros */
X
X switch (ix) {
CASE unsigned short and16
I unsigned short n
END
X
CASE unsigned short or16
I unsigned short n
END
X
CASE unsigned short xor16
I unsigned short n
END
X
CASE unsigned long and32
I unsigned long n
END
X
CASE unsigned long or32
I unsigned long n
END
X
CASE unsigned long xor32
I unsigned long n
END
X
CASE unsigned select
I unsigned n1
I unsigned n2
END
X
CASE unsigned mingle
I unsigned short n1
I unsigned short n2
END
X
X default:
X fatal("Unimplemented user-defined subroutine");
X }
X return sp;
}
X
static int
userval(ix, str)
int ix;
STR *str;
{
X switch (ix) {
X default:
X break;
X }
X return 0;
}
X
static int
userset(ix, str)
int ix;
STR *str;
{
X switch (ix) {
X default:
X break;
X }
X return 0;
}
X
/* INTERCAL Maths routines start here */
X
unsigned short and16(n)
unsigned short n;
{
X unsigned short n1;
X
X n1 = (n >> 1) | ((n & 01) << 15);
X return n & n1;
}
X
unsigned long and32(n)
unsigned long n;
{
X unsigned long n1;
X
X n1 = (n >> 1) | ((n & 01) << 31);
X return n & n1;
}
X
unsigned short or16(n)
unsigned short n;
{
X unsigned short n1;
X
X n &= 0177777;
X n1 = (n >> 1) | ((n & 01) << 15);
X return n | n1;
}
X
unsigned long or32(n)
unsigned long n;
{
X unsigned long n1;
X
X n1 = (n >> 1) | ((n & 01) << 31);
X return n | n1;
}
X
unsigned short xor16(n)
unsigned short n;
{
X unsigned short n1;
X
X n &= 0177777;
X n1 = (n >> 1) | ((n & 01) << 15);
X return n ^ n1;
}
X
unsigned long xor32(n)
unsigned long n;
{
X unsigned long n1;
X
X n1 = (n >> 1) | ((n & 01) << 31);
X return n ^ n1;
}
X
unsigned int select(n1, n2)
unsigned int n1, n2;
{
X unsigned int result = 0, bit = 0;
X
X while (n2 != 0)
X {
X if (n2 & 01)
X {
X result |= (n1 & 01) << bit++;
X }
X n1 >>= 1;
X n2 >>= 1;
X }
X
X return result;
}
X
unsigned int mingle(n1, n2)
unsigned short n1, n2;
{
X unsigned int result = 0, bit = 0;
X
X while ((n1 != 0) || (n2 != 0))
X {
X result |= (((n1 & 01) << 1) | (n2 & 01)) << (2 * bit++);
X n1 >>= 1;
X n2 >>= 1;
X }
X
X return(result);
}
SHAR_EOF
chmod 0644 ical.mus ||
echo 'restore of ical.mus failed'
Wc_c="`wc -c < 'ical.mus'`"
test 3330 -eq "$Wc_c" ||
echo 'ical.mus: original size 3330, current size' "$Wc_c"
fi
# ============= iperl.1 ==============
if test -f 'iperl.1' -a X"$1" != X"-c"; then
echo 'x - skipping iperl.1 (File already exists)'
else
echo 'x - extracting iperl.1 (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'iperl.1' &&
.po 8
.TH IPERL 1 Intercal/Perl
.ad
.nh
.SH NAME
iperl \- perl with intercal functions
.SH SYNOPSIS
\fBiperl\fP [options] filename args
.SH DESCRIPTION
\fIIperl\fP is an extension of \fIperl\fP
which retains all its original functionality,
but adds the ability to use \fIIntercal\fP operators.
X
The new operators are in the form of functions
and so are called using the \fBdo\fP or \fB&\fP syntax.
.SH Unary Operators
There are three unary operators,
each of which is available in 16\-bit and 32\-bit form.
The operators are
\fBand16\fP, \fBor16\fP, \fBnot16\fP, \fBand32\fP, \fBor32\fP, and \fBnot32\fP.
X
These operators perform their respective logical operations
on all pairs of adjacent bits,
the result from the first and last bits going into the first bit of the result.
The effect is that of rotating the operand one place to the right
and ANDing, ORing, or XORing with its initial value.
.br
.tl '''[Quoted from Woods and Lyon]'
.SH Binary Operators
There are two binary operators, mingle and select.
X
The \fImingle\fP operator takes two 16\-bit values
and produces a 32\-bit result by alternating the bits of the operands
X
The \fIselect\fP operator takes form the first operand
whichever bits correspond to 1's in the second operand,
and packs these bits at the right in the result.
.br
.tl '''[Quoted from Woods and Lyon]'
.SH EXAMPLES
See the file \fBop.ical\fP for examples.
.SH SEE ALSO
Woods, Donald R. and Lyon, James M.,
\fIThe Intercal Programming Language Reference Manual\fP, 1973.
X
Wall, Larry, and Schwartz, Randall,
\fIProgramming Perl\fP, 1990.
X
Any competent phrenologist, if you're thinking of using this!
.SH AUTHOR
It wasn't me, honest!
SHAR_EOF
chmod 0644 iperl.1 ||
echo 'restore of iperl.1 failed'
Wc_c="`wc -c < 'iperl.1'`"
test 1664 -eq "$Wc_c" ||
echo 'iperl.1: original size 1664, current size' "$Wc_c"
fi
# ============= iperlsh ==============
if test -f 'iperlsh' -a X"$1" != X"-c"; then
echo 'x - skipping iperlsh (File already exists)'
else
echo 'x - extracting iperlsh (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'iperlsh' &&
#!./iperl
X
# Poor man's perl intercal shell.
X
# input a mathematical expression, and its value will be printed
X
while (<>)
{
X print eval($_), "\n\n";
}
SHAR_EOF
chmod 0755 iperlsh ||
echo 'restore of iperlsh failed'
Wc_c="`wc -c < 'iperlsh'`"
test 152 -eq "$Wc_c" ||
echo 'iperlsh: original size 152, current size' "$Wc_c"
fi
# ============= op.ical ==============
if test -f 'op.ical' -a X"$1" != X"-c"; then
echo 'x - skipping op.ical (File already exists)'
else
echo 'x - extracting op.ical (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'op.ical' &&
#!./iperl
X
while (<DATA>)
{
X ($testno, $expr, $ans) = split(/ /);
X if (($got = eval($expr)) == $ans)
X {
X print "ok " . $testno . "\n";
X }
X else
X {
X print "not ok " . $testno . "\n";
X print "# $testno $expr wanted $ans got $got\n";
X }
}
__END__
1 &mingle(65535,0) 2863311530
2 &mingle(0,65535) 1431655765
3 &mingle(255,255) 65535
4 &select(179,201) 9
5 &select(201,179) 17
6 &select(179,179) 31
7 &select(201,201) 15
8 &and16(77) 4
9 &or16(77) 32879
10 &xor16(77) 32875
SHAR_EOF
chmod 0755 op.ical ||
echo 'restore of op.ical failed'
Wc_c="`wc -c < 'op.ical'`"
test 472 -eq "$Wc_c" ||
echo 'op.ical: original size 472, current size' "$Wc_c"
fi
# ============= usersub.c ==============
if test -f 'usersub.c' -a X"$1" != X"-c"; then
echo 'x - skipping usersub.c (File already exists)'
else
echo 'x - extracting usersub.c (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'usersub.c' &&
/* $Header: usersub.c,v 3.0.1.1 90/08/09 04:06:10 lwall Locked $
X *
X * $Log: usersub.c,v $
X * Revision 3.0.1.1 90/08/09 04:06:10 lwall
X * patch19: Initial revision
X *
X */
X
#include "EXTERN.h"
#include "perl.h"
X
int
userinit()
{
X init_ical();
}
X
SHAR_EOF
chmod 0644 usersub.c ||
echo 'restore of usersub.c failed'
Wc_c="`wc -c < 'usersub.c'`"
test 252 -eq "$Wc_c" ||
echo 'usersub.c: original size 252, current size' "$Wc_c"
fi
exit 0
--
,---------------.
,-+-------------. | Kevin Stock
| | E N C O R E | |
| `-------------+-' kstock@gouldfr.encore.fr
`---------------' kstock@gouldfr.UUCP
Any opinions expressed are my own, but may be reproduced under the terms
of the GNU licence. See the file COPYING at the end of this posting. :-)