kstock@mmcompta.encore.fr (Kevin Stock (MIS)) (01/29/91)
Submitted-by: kstock@mmcompta.encore.fr (Kevin Stock (MIS)) Posting-number: Volume 16, Issue 83 Archive-name: intercal.pl/part01 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? ,---------------. ,-+-------------. | Kevin Stock | | E N C O R E | | kstock@gouldfr.encore.fr | `-------------+-' `---------------' #!/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, \fBxor16\fP, \fBand32\fP, \fBor32\fP, and \fBxor32\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 from 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 exit 0 # Just in case... -- Kent Landfield INTERNET: kent@sparky.IMD.Sterling.COM Sterling Software, IMD UUCP: uunet!sparky!kent Phone: (402) 291-8300 FAX: (402) 291-4362 Please send comp.sources.misc-related mail to kent@uunet.uu.net.