See patch #19.
-/* $Header: eval.c,v 3.0.1.6 90/03/27 15:53:51 lwall Locked $
+/* $Header: eval.c,v 3.0.1.7 90/08/09 03:33:44 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: eval.c,v $
+ * Revision 3.0.1.7 90/08/09 03:33:44 lwall
+ * patch19: made ~ do vector operation on strings like &, | and ^
+ * patch19: dbmopen(%name...) didn't work right
+ * patch19: dbmopen(name, 'filename', undef) now refrains from creating
+ * patch19: empty %array now returns 0 in scalar context
+ * patch19: die with no arguments no longer exits unconditionally
+ * patch19: return outside a subroutine now returns a reasonable message
+ * patch19: rename done with unlink()/link()/unlink() now checks for clobbering
+ * patch19: -s now returns size of file
+ *
* Revision 3.0.1.6 90/03/27 15:53:51 lwall
* patch16: MSDOS support
* patch16: support for machines that can't cast negative floats to unsigned ints
#include "EXTERN.h"
#include "perl.h"
+#ifndef NSIG
#include <signal.h>
+#endif
#ifdef I_FCNTL
#include <fcntl.h>
if (when >= 0)
value = (double)(when % tmplong);
else
- value = (double)(tmplong - (-when % tmplong));
+ value = (double)(tmplong - ((-when - 1) % tmplong)) - 1;
#endif
goto donumset;
case O_ADD:
value = (double) !str_true(st[1]);
goto donumset;
case O_COMPLEMENT:
+ if (!sawvec || st[1]->str_nok) {
#ifndef lint
- value = (double) ~U_L(str_gnum(st[1]));
+ value = (double) ~U_L(str_gnum(st[1]));
#endif
- goto donumset;
+ goto donumset;
+ }
+ else {
+ STR_SSET(str,st[1]);
+ tmps = str_get(str);
+ for (anum = str->str_cur; anum; anum--)
+ *tmps = ~*tmps;
+ }
+ break;
case O_SELECT:
tmps = stab_name(defoutstab);
if (maxarg > 0) {
break;
case O_DBMOPEN:
#ifdef SOME_DBM
- if ((arg[1].arg_type & A_MASK) == A_WORD)
- stab = arg[1].arg_ptr.arg_stab;
+ stab = arg[1].arg_ptr.arg_stab;
+ if (st[3]->str_nok || st[3]->str_pok)
+ anum = (int)str_gnum(st[3]);
else
- stab = stabent(str_get(st[1]),TRUE);
- anum = (int)str_gnum(st[3]);
+ anum = -1;
value = (double)hdbmopen(stab_hash(stab),str_get(st[2]),anum);
goto donumset;
#else
#endif
case O_DBMCLOSE:
#ifdef SOME_DBM
- if ((arg[1].arg_type & A_MASK) == A_WORD)
- stab = arg[1].arg_ptr.arg_stab;
- else
- stab = stabent(str_get(st[1]),TRUE);
+ stab = arg[1].arg_ptr.arg_stab;
hdbmclose(stab_hash(stab));
goto say_yes;
#else
goto say_zero;
else
goto say_undef;
- break;
+ /* break; */
case O_TRANS:
value = (double) do_trans(str,arg);
str = arg->arg_ptr.arg_str;
astore(stack,sp + maxarg, Nullstr);
st = stack->ary_array;
}
- Copy(ary->ary_array, &st[sp+1], maxarg, STR*);
+ st += sp;
+ Copy(ary->ary_array, &st[1], maxarg, STR*);
sp += maxarg;
goto array_return;
}
}
else {
tmpstab = arg[1].arg_ptr.arg_stab;
+ if (!stab_hash(tmpstab)->tbl_fill)
+ goto say_zero;
sprintf(buf,"%d/%d",stab_hash(tmpstab)->tbl_fill,
stab_hash(tmpstab)->tbl_max+1);
str_set(str,buf);
gimme,arglast);
goto array_return;
case O_SPLICE:
- sp = do_splice(stab_array(arg[1].arg_ptr.arg_stab),str,gimme,arglast);
+ sp = do_splice(stab_array(arg[1].arg_ptr.arg_stab),gimme,arglast);
goto array_return;
case O_PUSH:
if (arglast[2] - arglast[1] != 1)
tmps = str_get(st[2]);
}
if (!tmps || !*tmps)
- exit(1);
+ tmps = "Died";
fatal("%s",tmps);
goto say_zero;
case O_PRTF:
}
#endif
}
- if (loop_ptr < 0)
+ if (loop_ptr < 0) {
+ if (tmps && strEQ(tmps, "_SUB_"))
+ fatal("Can't return outside a subroutine");
fatal("Bad label: %s", maxarg > 0 ? tmps : "<null>");
+ }
if (!lastretstr && optype == O_LAST && lastsize) {
st -= arglast[0];
st += lastspbase + 1;
sp = do_time(str,gmtime(&when),
gimme,arglast);
goto array_return;
+ case O_TRUNCATE:
+ sp = do_truncate(str,arg,
+ gimme,arglast);
+ goto array_return;
case O_LSTAT:
case O_STAT:
sp = do_stat(str,arg,
argtype = arg[2].arg_type & A_MASK;
argptr = arg[2].arg_ptr;
sp = arglast[0];
- st -= sp;
+ st -= sp++;
goto re_eval;
}
str_set(str,"");
else {
value = (double)((unsigned int)argflags & 0xffff);
}
+ do_execfree(); /* free any memory child malloced on vfork */
goto donumset;
}
if ((arg[1].arg_type & A_MASK) == A_STAB)
#ifdef RENAME
value = (double)(rename(tmps,tmps2) >= 0);
#else
- if (euid || stat(tmps2,&statbuf) < 0 ||
- (statbuf.st_mode & S_IFMT) != S_IFDIR )
- (void)UNLINK(tmps2); /* avoid unlinking a directory */
- if (!(anum = link(tmps,tmps2)))
- anum = UNLINK(tmps);
+ if (same_dirent(tmps2, tmps) /* can always rename to same name */
+ anum = 1;
+ else {
+ if (euid || stat(tmps2,&statbuf) < 0 ||
+ (statbuf.st_mode & S_IFMT) != S_IFDIR )
+ (void)UNLINK(tmps2);
+ if (!(anum = link(tmps,tmps2)))
+ anum = UNLINK(tmps);
+ }
value = (double)(anum >= 0);
#endif
goto donumset;
}
value = (double)(ary->ary_fill + 1);
break;
+
+ case O_REQUIRE:
case O_DOFILE:
case O_EVAL:
if (maxarg < 1)
case O_FTSIZE:
if (mystat(arg,st[1]) < 0)
goto say_undef;
- if (statcache.st_size)
- goto say_yes;
- goto say_no;
+ value = (double)statcache.st_size;
+ goto donumset;
case O_FTSOCK:
#ifdef S_IFSOCK
case O_ESERVENT:
value = (double) endservent();
goto donumset;
- case O_SSELECT:
- sp = do_select(gimme,arglast);
- goto array_return;
- case O_SOCKETPAIR:
+ case O_SOCKPAIR:
if ((arg[1].arg_type & A_MASK) == A_WORD)
stab = arg[1].arg_ptr.arg_stab;
else
case O_CONNECT:
case O_LISTEN:
case O_ACCEPT:
- case O_SSELECT:
- case O_SOCKETPAIR:
+ case O_SOCKPAIR:
case O_GHBYNAME:
case O_GHBYADDR:
case O_GHOSTENT:
badsock:
fatal("Unsupported socket function");
#endif /* SOCKET */
+ case O_SSELECT:
+#ifdef SELECT
+ sp = do_select(gimme,arglast);
+ goto array_return;
+#else
+ fatal("select not implemented");
+#endif
case O_FILENO:
if (maxarg < 1)
goto say_undef;
deb("%s RETURNS (\"%s\")\n",opname[optype],str_get(st[1]));
break;
default:
- deb("%s RETURNS %d ARGS (\"%s\",%s\"%s\"\n",opname[optype],anum,
- str_get(st[1]),anum==2?"":"...,",str_get(st[anum]));
+ tmps = str_get(st[1]);
+ deb("%s RETURNS %d ARGS (\"%s\",%s\"%s\")\n",opname[optype],
+ anum,tmps,anum==2?"":"...,",str_get(st[anum]));
break;
}
}
* kit sizes from getting too big.
*/
-/* $Header: evalargs.xc,v 3.0.1.5 90/03/27 15:54:42 lwall Locked $
+/* $Header: evalargs.xc,v 3.0.1.6 90/08/09 03:37:15 lwall Locked $
*
* $Log: evalargs.xc,v $
+ * Revision 3.0.1.6 90/08/09 03:37:15 lwall
+ * patch19: passing *name to subroutine now forces filehandle and array creation
+ * patch19: `command` in array context now returns array of lines
+ * patch19: <handle> input is a little more efficient
+ *
* Revision 3.0.1.5 90/03/27 15:54:42 lwall
* patch16: MSDOS support
*
#endif
break;
case A_STAR:
- st[++sp] = (STR*)argptr.arg_stab;
+ stab = argptr.arg_stab;
+ st[++sp] = (STR*)stab;
+ if (!stab_xarray(stab))
+ aadd(stab);
+ if (!stab_xhash(stab))
+ hadd(stab);
+ if (!stab_io(stab))
+ stab_io(stab) = stio_new();
#ifdef DEBUGGING
if (debug & 8) {
(void)sprintf(buf,"STAR *%s",stab_name(argptr.arg_stab));
fp = mypopen(tmps,"r");
str_set(str,"");
if (fp) {
- while (str_gets(str,fp,str->str_cur) != Nullch)
- ;
+ if (gimme == G_SCALAR) {
+ while (str_gets(str,fp,str->str_cur) != Nullch)
+ ;
+ }
+ else {
+ for (;;) {
+ if (++sp > stack->ary_max) {
+ astore(stack, sp, Nullstr);
+ st = stack->ary_array;
+ }
+ st[sp] = str_static(&str_undef);
+ if (str_gets(st[sp],fp,0) == Nullch) {
+ sp--;
+ break;
+ }
+ }
+ }
statusvalue = mypclose(fp);
}
else
statusvalue = -1;
- st[++sp] = str;
+ if (gimme == G_SCALAR)
+ st[++sp] = str;
#ifdef DEBUGGING
tmps = "BACK";
#endif
do_read:
if (anum > 1) /* assign to scalar */
gimme = G_SCALAR; /* force context to scalar */
+ if (gimme == G_ARRAY)
+ str = str_static(&str_undef);
++sp;
fp = Nullfp;
if (stab_io(last_in_stab)) {
goto keepgoing; /* unmatched wildcard? */
}
if (gimme == G_ARRAY) {
- st[sp] = str_static(st[sp]);
if (++sp > stack->ary_max) {
astore(stack, sp, Nullstr);
st = stack->ary_array;
}
+ str = str_static(&str_undef);
goto keepgoing;
}
}
-/* $Header: form.c,v 3.0.1.1 90/02/28 17:39:34 lwall Locked $
+/* $Header: form.c,v 3.0.1.2 90/08/09 03:38:40 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: form.c,v $
+ * Revision 3.0.1.2 90/08/09 03:38:40 lwall
+ * patch19: did preliminary work toward debugging packages and evals
+ *
* Revision 3.0.1.1 90/02/28 17:39:34 lwall
* patch9: ... in format threw off subsequent field
*
register int items;
STR *str;
ARG *parselist();
- line_t oldline = line;
+ line_t oldline = curcmd->c_line;
int oldsave = savestack->ary_fill;
str = fcmd->f_unparsed;
- line = fcmd->f_line;
+ curcmd->c_line = fcmd->f_line;
fcmd->f_unparsed = Nullstr;
(void)savehptr(&curstash);
curstash = str->str_u.str_hash;
}
if (fcmd && fcmd->f_type)
fatal("Not enough field values");
- line = oldline;
+ curcmd->c_line = oldline;
Safefree(arg);
str_free(str);
}
break;
}
}
+ CHKLEN(1);
*d++ = '\0';
}
--- /dev/null
+case $CONFIG in
+'')
+ if test ! -f config.sh; then
+ ln ../config.sh . || \
+ ln ../../config.sh . || \
+ ln ../../../config.sh . || \
+ (echo "Can't find config.sh."; exit 1)
+ fi
+ . config.sh
+ ;;
+esac
+: This forces SH files to create target in same directory as SH file.
+: This is so that make depend always knows where to find SH derivatives.
+case "$0" in
+*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
+esac
+echo "Extracting h2ph (with variable substitutions)"
+: This section of the file will have variable substitutions done on it.
+: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!.
+: Protect any dollar signs and backticks that you do not want interpreted
+: by putting a backslash in front. You may delete these comments.
+$spitshell >h2ph <<!GROK!THIS!
+#!$bin/perl
+'di';
+'ig00';
+
+\$perlincl = '$privlib';
+!GROK!THIS!
+
+: In the following dollars and backticks do not need the extra backslash.
+$spitshell >>h2ph <<'!NO!SUBS!'
+
+chdir '/usr/include' || die "Can't cd /usr/include";
+
+%isatype = ('char',1,'short',1,'int',1,'long',1);
+
+foreach $file (@ARGV) {
+ ($outfile = $file) =~ s/\.h$/.ph/;
+ print "$file -> $outfile\n";
+ if ($file =~ m|^(.*)/|) {
+ $dir = $1;
+ if (!-d "$perlincl/$dir") {
+ mkdir("$perlincl/$dir",0777);
+ }
+ }
+ open(IN,"$file") || ((warn "Can't open $file: $!\n"),next);
+ open(OUT,">$perlincl/$outfile") || die "Can't create $outfile: $!\n";
+ while (<IN>) {
+ chop;
+ while (/\\$/) {
+ chop;
+ $_ .= <IN>;
+ chop;
+ }
+ if (s:/\*:\200:g) {
+ s:\*/:\201:g;
+ s/\200[^\201]*\201//g; # delete single line comments
+ if (s/\200.*//) { # begin multi-line comment?
+ $_ .= '/*';
+ $_ .= <IN>;
+ redo;
+ }
+ }
+ if (s/^#\s*//) {
+ if (s/^define\s+(\w+)//) {
+ $name = $1;
+ $new = '';
+ s/\s+$//;
+ if (s/^\(([\w,\s]*)\)//) {
+ $args = $1;
+ if ($args ne '') {
+ foreach $arg (split(/,\s*/,$args)) {
+ $curargs{$arg} = 1;
+ }
+ $args =~ s/\b(\w)/\$$1/g;
+ $args = "local($args) = \@_;\n$t ";
+ }
+ s/^\s+//;
+ do expr();
+ $new =~ s/(["\\])/\\$1/g;
+ if ($t ne '') {
+ $new =~ s/(['\\])/\\$1/g;
+ print OUT $t,
+ "eval 'sub $name {\n$t ${args}eval \"$new\";\n$t}';\n";
+ }
+ else {
+ print OUT "sub $name {\n ${args}eval \"$new\";\n}\n";
+ }
+ %curargs = ();
+ }
+ else {
+ s/^\s+//;
+ do expr();
+ $new = 1 if $new eq '';
+ if ($t ne '') {
+ $new =~ s/(['\\])/\\$1/g;
+ print OUT $t,"eval 'sub $name {",$new,";}';\n";
+ }
+ else {
+ print OUT $t,"sub $name {",$new,";}\n";
+ }
+ }
+ }
+ elsif (/^include <(.*)>/) {
+ print OUT $t,"do '$1' || die \"Can't include $1: \$!\";\n";
+ }
+ elsif (/^ifdef\s+(\w+)/) {
+ print OUT $t,"if (defined &$1) {\n";
+ $tab += 4;
+ $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+ }
+ elsif (/^ifndef\s+(\w+)/) {
+ print OUT $t,"if (!defined &$1) {\n";
+ $tab += 4;
+ $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+ }
+ elsif (s/^if\s+//) {
+ $new = '';
+ do expr();
+ print OUT $t,"if ($new) {\n";
+ $tab += 4;
+ $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+ }
+ elsif (s/^elif\s+//) {
+ $new = '';
+ do expr();
+ $tab -= 4;
+ $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+ print OUT $t,"}\n${t}elsif ($new) {\n";
+ $tab += 4;
+ $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+ }
+ elsif (/^else/) {
+ $tab -= 4;
+ $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+ print OUT $t,"}\n${t}else {\n";
+ $tab += 4;
+ $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+ }
+ elsif (/^endif/) {
+ $tab -= 4;
+ $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
+ print OUT $t,"}\n";
+ }
+ }
+ }
+ print OUT "1;\n";
+}
+
+sub expr {
+ while ($_ ne '') {
+ s/^(\s+)// && do {$new .= ' '; next;};
+ s/^(0x[0-9a-fA-F]+)// && do {$new .= $1; next;};
+ s/^(\d+)// && do {$new .= $1; next;};
+ s/^("(\\"|[^"])*")// && do {$new .= $1; next;};
+ s/^'((\\"|[^"])*)'// && do {
+ if ($curargs{$1}) {
+ $new .= "ord('\$$1')";
+ }
+ else {
+ $new .= "ord('$1')";
+ }
+ next;
+ };
+ s/^(struct\s+\w+)// && do {$new .= "'$1'"; next;};
+ s/^sizeof\s*\(([^)]+)\)/{$1}/ && do {
+ $new .= '$sizeof';
+ next;
+ };
+ s/^([_a-zA-Z]\w*)// && do {
+ $id = $1;
+ if ($curargs{$id}) {
+ $new .= '$' . $id;
+ }
+ elsif ($id eq 'defined') {
+ $new .= 'defined';
+ }
+ elsif (/^\(/) {
+ s/^\((\w),/("$1",/ if $id =~ /^_IO[WR]*$/; # cheat
+ $new .= " &$id";
+ }
+ elsif ($isatype{$id}) {
+ $new .= "'$id'";
+ }
+ else {
+ $new .= ' &' . $id;
+ }
+ next;
+ };
+ s/^(.)// && do {$new .= $1; next;};
+ }
+}
+##############################################################################
+
+ # These next few lines are legal in both Perl and nroff.
+
+.00; # finish .ig
+
+'di \" finish diversion--previous line must be blank
+.nr nl 0-1 \" fake up transition to first page again
+.nr % 0 \" start at page 1
+'; __END__ ############# From here on it's a standard manual page ############
+.TH H2PH 1 "August 8, 1990"
+.AT 3
+.SH NAME
+h2ph \- convert .h C header files to .ph Perl header files
+.SH SYNOPSIS
+.B h2ph [headerfiles]
+.SH DESCRIPTION
+.I h2ph
+converts any C header files specified to the corresponding Perl header file
+format.
+It is most easily run while in /usr/include:
+.nf
+
+ cd /usr/include; h2ph * sys/*
+
+.fi
+.SH ENVIRONMENT
+No environment variables are used.
+.SH FILES
+/usr/include/*.h
+.br
+/usr/include/sys/*.h
+.br
+etc.
+.SH AUTHOR
+Larry Wall
+.SH "SEE ALSO"
+perl(1)
+.SH DIAGNOSTICS
+The usual warnings if it can't read or write the files involved.
+.SH BUGS
+Doesn't construct the %sizeof array for you.
+.PP
+It doesn't handle all C constructs, but it does attempt to isolate
+definitions inside evals so that you can get at the definitions
+that it can translate.
+.PP
+It's only intended as a rough tool.
+You may need to dicker with the files produced.
+.ex
+!NO!SUBS!
+chmod 755 h2ph
+$eunicefix h2ph
+rm -f h2ph.man
+ln h2ph h2ph.man
--- /dev/null
+$EPERM = 0x1;
+$ENOENT = 0x2;
+$ESRCH = 0x3;
+$EINTR = 0x4;
+$EIO = 0x5;
+$ENXIO = 0x6;
+$E2BIG = 0x7;
+$ENOEXEC = 0x8;
+$EBADF = 0x9;
+$ECHILD = 0xA;
+$EAGAIN = 0xB;
+$ENOMEM = 0xC;
+$EACCES = 0xD;
+$EFAULT = 0xE;
+$ENOTBLK = 0xF;
+$EBUSY = 0x10;
+$EEXIST = 0x11;
+$EXDEV = 0x12;
+$ENODEV = 0x13;
+$ENOTDIR = 0x14;
+$EISDIR = 0x15;
+$EINVAL = 0x16;
+$ENFILE = 0x17;
+$EMFILE = 0x18;
+$ENOTTY = 0x19;
+$ETXTBSY = 0x1A;
+$EFBIG = 0x1B;
+$ENOSPC = 0x1C;
+$ESPIPE = 0x1D;
+$EROFS = 0x1E;
+$EMLINK = 0x1F;
+$EPIPE = 0x20;
+$EDOM = 0x21;
+$ERANGE = 0x22;
+$EWOULDBLOCK = 0x23;
+$EINPROGRESS = 0x24;
+$EALREADY = 0x25;
+$ENOTSOCK = 0x26;
+$EDESTADDRREQ = 0x27;
+$EMSGSIZE = 0x28;
+$EPROTOTYPE = 0x29;
+$ENOPROTOOPT = 0x2A;
+$EPROTONOSUPPORT = 0x2B;
+$ESOCKTNOSUPPORT = 0x2C;
+$EOPNOTSUPP = 0x2D;
+$EPFNOSUPPORT = 0x2E;
+$EAFNOSUPPORT = 0x2F;
+$EADDRINUSE = 0x30;
+$EADDRNOTAVAIL = 0x31;
+$ENETDOWN = 0x32;
+$ENETUNREACH = 0x33;
+$ENETRESET = 0x34;
+$ECONNABORTED = 0x35;
+$ECONNRESET = 0x36;
+$ENOBUFS = 0x37;
+$EISCONN = 0x38;
+$ENOTCONN = 0x39;
+$ESHUTDOWN = 0x3A;
+$ETOOMANYREFS = 0x3B;
+$ETIMEDOUT = 0x3C;
+$ECONNREFUSED = 0x3D;
+$ELOOP = 0x3E;
+$ENAMETOOLONG = 0x3F;
+$EHOSTDOWN = 0x40;
+$EHOSTUNREACH = 0x41;
+$ENOTEMPTY = 0x42;
+$EPROCLIM = 0x43;
+$EUSERS = 0x44;
+$EDQUOT = 0x45;
+$ESTALE = 0x46;
+$EREMOTE = 0x47;
+$EDEADLK = 0x48;
+$ENOLCK = 0x49;
+$MTH_UNDEF_SQRT = 0x12C;
+$MTH_OVF_EXP = 0x12D;
+$MTH_UNDEF_LOG = 0x12E;
+$MTH_NEG_BASE = 0x12F;
+$MTH_ZERO_BASE = 0x130;
+$MTH_OVF_POW = 0x131;
+$MTH_LRG_SIN = 0x132;
+$MTH_LRG_COS = 0x133;
+$MTH_LRG_TAN = 0x134;
+$MTH_LRG_COT = 0x135;
+$MTH_OVF_TAN = 0x136;
+$MTH_OVF_COT = 0x137;
+$MTH_UNDEF_ASIN = 0x138;
+$MTH_UNDEF_ACOS = 0x139;
+$MTH_UNDEF_ATAN2 = 0x13A;
+$MTH_OVF_SINH = 0x13B;
+$MTH_OVF_COSH = 0x13C;
+$MTH_UNDEF_ZLOG = 0x13D;
+$MTH_UNDEF_ZDIV = 0x13E;
--- /dev/null
+$_IOCTL_ = 0x1;
+$TIOCGSIZE = 0x40087468;
+$TIOCSSIZE = 0x80087467;
+$IOCPARM_MASK = 0x7F;
+$IOC_VOID = 0x20000000;
+$IOC_OUT = 0x40000000;
+$IOC_IN = 0x80000000;
+$IOC_INOUT = 0xC0000000;
+$TIOCGETD = 0x40047400;
+$TIOCSETD = 0x80047401;
+$TIOCHPCL = 0x20007402;
+$TIOCMODG = 0x40047403;
+$TIOCMODS = 0x80047404;
+$TIOCM_LE = 0x1;
+$TIOCM_DTR = 0x2;
+$TIOCM_RTS = 0x4;
+$TIOCM_ST = 0x8;
+$TIOCM_SR = 0x10;
+$TIOCM_CTS = 0x20;
+$TIOCM_CAR = 0x40;
+$TIOCM_CD = 0x40;
+$TIOCM_RNG = 0x80;
+$TIOCM_RI = 0x80;
+$TIOCM_DSR = 0x100;
+$TIOCGETP = 0x40067408;
+$TIOCSETP = 0x80067409;
+$TIOCSETN = 0x8006740A;
+$TIOCEXCL = 0x2000740D;
+$TIOCNXCL = 0x2000740E;
+$TIOCFLUSH = 0x80047410;
+$TIOCSETC = 0x80067411;
+$TIOCGETC = 0x40067412;
+$TIOCSET = 0x80047413;
+$TIOCBIS = 0x80047414;
+$TIOCBIC = 0x80047415;
+$TIOCGET = 0x40047416;
+$TANDEM = 0x1;
+$CBREAK = 0x2;
+$LCASE = 0x4;
+$ECHO = 0x8;
+$CRMOD = 0x10;
+$RAW = 0x20;
+$ODDP = 0x40;
+$EVENP = 0x80;
+$ANYP = 0xC0;
+$NLDELAY = 0x300;
+$NL0 = 0x0;
+$NL1 = 0x100;
+$NL2 = 0x200;
+$NL3 = 0x300;
+$TBDELAY = 0xC00;
+$TAB0 = 0x0;
+$TAB1 = 0x400;
+$TAB2 = 0x800;
+$XTABS = 0xC00;
+$CRDELAY = 0x3000;
+$CR0 = 0x0;
+$CR1 = 0x1000;
+$CR2 = 0x2000;
+$CR3 = 0x3000;
+$VTDELAY = 0x4000;
+$FF0 = 0x0;
+$FF1 = 0x4000;
+$BSDELAY = 0x8000;
+$BS0 = 0x0;
+$BS1 = 0x8000;
+$ALLDELAY = 0xFF00;
+$CRTBS = 0x10000;
+$PRTERA = 0x20000;
+$CRTERA = 0x40000;
+$TILDE = 0x80000;
+$MDMBUF = 0x100000;
+$LITOUT = 0x200000;
+$TOSTOP = 0x400000;
+$FLUSHO = 0x800000;
+$NOHANG = 0x1000000;
+$L001000 = 0x2000000;
+$CRTKIL = 0x4000000;
+$L004000 = 0x8000000;
+$CTLECH = 0x10000000;
+$PENDIN = 0x20000000;
+$DECCTQ = 0x40000000;
+$NOFLSH = 0x80000000;
+$TIOCCSET = 0x800E7417;
+$TIOCCGET = 0x400E7418;
+$TIOCLBIS = 0x8004747F;
+$TIOCLBIC = 0x8004747E;
+$TIOCLSET = 0x8004747D;
+$TIOCLGET = 0x4004747C;
+$LCRTBS = 0x1;
+$LPRTERA = 0x2;
+$LCRTERA = 0x4;
+$LTILDE = 0x8;
+$LMDMBUF = 0x10;
+$LLITOUT = 0x20;
+$LTOSTOP = 0x40;
+$LFLUSHO = 0x80;
+$LNOHANG = 0x100;
+$LCRTKIL = 0x400;
+$LCTLECH = 0x1000;
+$LPENDIN = 0x2000;
+$LDECCTQ = 0x4000;
+$LNOFLSH = 0x8000;
+$TIOCSBRK = 0x2000747B;
+$TIOCCBRK = 0x2000747A;
+$TIOCSDTR = 0x20007479;
+$TIOCCDTR = 0x20007478;
+$TIOCGPGRP = 0x40047477;
+$TIOCSPGRP = 0x80047476;
+$TIOCSLTC = 0x80067475;
+$TIOCGLTC = 0x40067474;
+$TIOCOUTQ = 0x40047473;
+$TIOCSTI = 0x80017472;
+$TIOCNOTTY = 0x20007471;
+$TIOCPKT = 0x80047470;
+$TIOCPKT_DATA = 0x0;
+$TIOCPKT_FLUSHREAD = 0x1;
+$TIOCPKT_FLUSHWRITE = 0x2;
+$TIOCPKT_STOP = 0x4;
+$TIOCPKT_START = 0x8;
+$TIOCPKT_NOSTOP = 0x10;
+$TIOCPKT_DOSTOP = 0x20;
+$TIOCSTOP = 0x2000746F;
+$TIOCSTART = 0x2000746E;
+$TIOCREMOTE = 0x20007469;
+$TIOCGWINSZ = 0x40087468;
+$TIOCSWINSZ = 0x80087467;
+$TIOCRESET = 0x20007466;
+$OTTYDISC = 0x0;
+$NETLDISC = 0x1;
+$NTTYDISC = 0x2;
+$FIOCLEX = 0x20006601;
+$FIONCLEX = 0x20006602;
+$FIONREAD = 0x4004667F;
+$FIONBIO = 0x8004667E;
+$FIOASYNC = 0x8004667D;
+$FIOSETOWN = 0x8004667C;
+$FIOGETOWN = 0x4004667B;
+$STPUTTABLE = 0x8004667A;
+$STGETTABLE = 0x80046679;
+$SIOCSHIWAT = 0x80047300;
+$SIOCGHIWAT = 0x40047301;
+$SIOCSLOWAT = 0x80047302;
+$SIOCGLOWAT = 0x40047303;
+$SIOCATMARK = 0x40047307;
+$SIOCSPGRP = 0x80047308;
+$SIOCGPGRP = 0x40047309;
+$SIOCADDRT = 0x8034720A;
+$SIOCDELRT = 0x8034720B;
+$SIOCSIFADDR = 0x8020690C;
+$SIOCGIFADDR = 0xC020690D;
+$SIOCSIFDSTADDR = 0x8020690E;
+$SIOCGIFDSTADDR = 0xC020690F;
+$SIOCSIFFLAGS = 0x80206910;
+$SIOCGIFFLAGS = 0xC0206911;
+$SIOCGIFBRDADDR = 0xC0206912;
+$SIOCSIFBRDADDR = 0x80206913;
+$SIOCGIFCONF = 0xC0086914;
+$SIOCGIFNETMASK = 0xC0206915;
+$SIOCSIFNETMASK = 0x80206916;
+$SIOCGIFMETRIC = 0xC0206917;
+$SIOCSIFMETRIC = 0x80206918;
+$SIOCSARP = 0x8024691E;
+$SIOCGARP = 0xC024691F;
+$SIOCDARP = 0x80246920;
+$PIXCONTINUE = 0x80747000;
+$PIXSTEP = 0x80747001;
+$PIXTERMINATE = 0x20007002;
+$PIGETFLAGS = 0x40747003;
+$PIXINHERIT = 0x80747004;
+$PIXDETACH = 0x20007005;
+$PIXGETSUBCODE = 0xC0747006;
+$PIXRDREGS = 0xC0747007;
+$PIXWRREGS = 0xC0747008;
+$PIXRDVREGS = 0xC0747009;
+$PIXWRVREGS = 0xC074700A;
+$PIXRDVSTATE = 0xC074700B;
+$PIXWRVSTATE = 0xC074700C;
+$PIXRDCREGS = 0xC074700D;
+$PIXWRCREGS = 0xC074700E;
+$PIRDSDRS = 0xC074700F;
+$PIXGETSIGACTION = 0xC0747010;
+$PIGETU = 0xC0747011;
+$PISETRWTID = 0xC0747012;
+$PIXGETTHCOUNT = 0xC0747013;
+$PIXRUN = 0x20007014;
--- /dev/null
+#!/usr/bin/perl
+
+open (IOCTLS,'/usr/include/sys/ioctl.h') || die "ioctl open failed";
+
+while (<IOCTLS>) {
+ if (/^\s*#\s*define\s+\w+\s+_IO(R|W|WR)\(\w+,\s*\w+,\s*([^)]+)/) {
+ $need{$2}++;
+ }
+}
+
+foreach $key ( sort keys %need ) {
+ print $key,"\n";
+}
-/* $Header: handy.h,v 3.0.1.1 89/11/17 15:25:55 lwall Locked $
+/* $Header: handy.h,v 3.0.1.2 90/08/09 03:48:28 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: handy.h,v $
+ * Revision 3.0.1.2 90/08/09 03:48:28 lwall
+ * patch19: various MSDOS and OS/2 patches folded in
+ *
* Revision 3.0.1.1 89/11/17 15:25:55 lwall
* patch5: some machines already define TRUE and FALSE
*
char *safemalloc();
char *saferealloc();
void safefree();
+#ifndef MSDOS
#define New(x,v,n,t) (v = (t*)safemalloc((MEM_SIZE)((n) * sizeof(t))))
#define Newc(x,v,n,t,c) (v = (c*)safemalloc((MEM_SIZE)((n) * sizeof(t))))
#define Newz(x,v,n,t) (v = (t*)safemalloc((MEM_SIZE)((n) * sizeof(t)))), \
bzero((char*)(v), (n) * sizeof(t))
#define Renew(v,n,t) (v = (t*)saferealloc((char*)(v),(MEM_SIZE)((n)*sizeof(t))))
#define Renewc(v,n,t,c) (v = (c*)saferealloc((char*)(v),(MEM_SIZE)((n)*sizeof(t))))
+#else
+#define New(x,v,n,t) (v = (t*)safemalloc(((unsigned long)(n) * sizeof(t))))
+#define Newc(x,v,n,t,c) (v = (c*)safemalloc(((unsigned long)(n) * sizeof(t))))
+#define Newz(x,v,n,t) (v = (t*)safemalloc(((unsigned long)(n) * sizeof(t)))), \
+ bzero((char*)(v), (n) * sizeof(t))
+#define Renew(v,n,t) (v = (t*)saferealloc((char*)(v),((unsigned long)(n)*sizeof(t))))
+#define Renewc(v,n,t,c) (v = (c*)saferealloc((char*)(v),((unsigned long)(n)*sizeof(t))))
+#endif /* MSDOS */
#define Safefree(d) safefree((char*)d)
#define Str_new(x,len) str_new(len)
#else /* LEAKTEST */
-/* $Header: hash.c,v 3.0.1.3 90/03/27 15:59:09 lwall Locked $
+/* $Header: hash.c,v 3.0.1.4 90/08/09 03:50:22 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: hash.c,v $
+ * Revision 3.0.1.4 90/08/09 03:50:22 lwall
+ * patch19: dbmopen(name, 'filename', undef) now refrains from creating
+ *
* Revision 3.0.1.3 90/03/27 15:59:09 lwall
* patch16: @dbmvalues{'foo','bar'} could use the same cache entry for both values
*
#include "EXTERN.h"
#include "perl.h"
+static char coeff[] = {
+ 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
+ 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
+ 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
+ 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
+ 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
+ 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
+ 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
+ 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1};
+
STR *
hfetch(tb,key,klen,lval)
register HASH *tb;
if (tb->tbl_dbm) /* never really closed it */
return TRUE;
#endif
- if (tb->tbl_dbm)
+ if (tb->tbl_dbm) {
hdbmclose(tb);
+ tb->tbl_dbm = 0;
+ }
hclear(tb);
#ifdef NDBM
- tb->tbl_dbm = dbm_open(fname, O_RDWR|O_CREAT, mode);
- if (!tb->tbl_dbm) /* oops, just try reading it */
- tb->tbl_dbm = dbm_open(fname, O_RDONLY, mode);
+ if (mode >= 0)
+ tb->tbl_dbm = dbm_open(fname, O_RDWR|O_CREAT, mode);
+ if (!tb->tbl_dbm)
+ tb->tbl_dbm = dbm_open(fname, O_RDWR, mode);
#else
if (dbmrefcnt++)
fatal("Old dbm can only open one database");
sprintf(buf,"%s.dir",fname);
if (stat(buf, &statbuf) < 0) {
- if (close(creat(buf,mode)) < 0)
+ if (mode < 0 || close(creat(buf,mode)) < 0)
return FALSE;
sprintf(buf,"%s.pag",fname);
if (close(creat(buf,mode)) < 0)
-/* $Header: hash.h,v 3.0 89/10/18 15:18:39 lwall Locked $
+/* $Header: hash.h,v 3.0.1.1 90/08/09 03:51:34 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: hash.h,v $
+ * Revision 3.0.1.1 90/08/09 03:51:34 lwall
+ * patch19: various MSDOS and OS/2 patches folded in
+ *
* Revision 3.0 89/10/18 15:18:39 lwall
* 3.0 baseline
*
#define DBM_CACHE_MAX 63 /* cache 64 entries for dbm file */
/* (resident array acts as a write-thru cache)*/
-#define COEFFSIZE (16 * 8) /* size of array below */
-#ifdef DOINIT
-char coeff[] = {
- 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
- 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
- 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
- 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
- 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
- 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
- 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
- 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1};
-#else
-extern char coeff[];
-#endif
+#define COEFFSIZE (16 * 8) /* size of coeff array */
typedef struct hentry HENT;
package dumpvar;
+# translate control chars to ^X - Randal Schwartz
+sub unctrl {
+ local($_) = @_;
+ s/([\001-\037\177])/'^'.pack('c',ord($1)^64)/eg;
+ $_;
+}
sub main'dumpvar {
- ($package) = @_;
+ ($package,@vars) = @_;
local(*stab) = eval("*_$package");
while (($key,$val) = each(%stab)) {
{
+ next if @vars && !grep($key eq $_,@vars);
local(*entry) = $val;
if (defined $entry) {
- print "\$$key = '$entry'\n";
+ print "\$$key = '",&unctrl($entry),"'\n";
}
if (defined @entry) {
print "\@$key = (\n";
foreach $num ($[ .. $#entry) {
- print " $num\t'",$entry[$num],"'\n";
+ print " $num\t'",&unctrl($entry[$num]),"'\n";
}
print ")\n";
}
if ($key ne "_$package" && defined %entry) {
print "\%$key = (\n";
foreach $key (sort keys(%entry)) {
- print " $key\t'",$entry{$key},"'\n";
+ print " $key\t'",&unctrl($entry{$key}),"'\n";
}
print ")\n";
}
--- /dev/null
+;# Usage: &flush(FILEHANDLE)
+;# flushes the named filehandle
+
+;# Usage: &printflush(FILEHANDLE, "prompt: ")
+;# prints arguments and flushes filehandle
+
+sub flush {
+ local($old) = select(shift);
+ $| = 1;
+ print "";
+ $| = 0;
+ select($old);
+}
+
+sub printflush {
+ local($old) = select(shift);
+ $| = 1;
+ print @_;
+ $| = 0;
+ select($old);
+}
+
-;# $Header: importenv.pl,v 3.0 89/10/18 15:19:39 lwall Locked $
+;# $Header: importenv.pl,v 3.0.1.1 90/08/09 03:56:38 lwall Locked $
;# This file, when interpreted, pulls the environment into normal variables.
;# Usage:
-;# do 'importenv.pl';
+;# require 'importenv.pl';
;# or
;# #include <importenv.pl>
-case $CONFIG in
-'')
- if test ! -f config.sh; then
- ln ../config.sh . || \
- ln ../../config.sh . || \
- ln ../../../config.sh . || \
- (echo "Can't find config.sh."; exit 1)
- fi
- . config.sh
- ;;
-esac
-: This forces SH files to create target in same directory as SH file.
-: This is so that make depend always knows where to find SH derivatives.
-case "$0" in
-*/*) cd `expr X$0 : 'X\(.*\)/'` ;;
-esac
-echo "Extracting makelib (with variable substitutions)"
-: This section of the file will have variable substitutions done on it.
-: Move anything that needs config subs from !NO!SUBS! section to !GROK!THIS!.
-: Protect any dollar signs and backticks that you do not want interpreted
-: by putting a backslash in front. You may delete these comments.
-$spitshell >makelib <<!GROK!THIS!
-#!/usr/bin/perl
-
-\$perlincl = '$privlib';
-!GROK!THIS!
-
-: In the following dollars and backticks do not need the extra backslash.
-$spitshell >>makelib <<'!NO!SUBS!'
-
-chdir '/usr/include' || die "Can't cd /usr/include";
-
-%isatype = ('char',1,'short',1,'int',1,'long',1);
-
-foreach $file (@ARGV) {
- print $file,"\n";
- if ($file =~ m|^(.*)/|) {
- $dir = $1;
- if (!-d "$perlincl/$dir") {
- mkdir("$perlincl/$dir",0777);
- }
- }
- open(IN,"$file") || ((warn "Can't open $file: $!\n"),next);
- open(OUT,">$perlincl/$file") || die "Can't create $file: $!\n";
- while (<IN>) {
- chop;
- while (/\\$/) {
- chop;
- $_ .= <IN>;
- chop;
- }
- if (s:/\*:\200:g) {
- s:\*/:\201:g;
- s/\200[^\201]*\201//g; # delete single line comments
- if (s/\200.*//) { # begin multi-line comment?
- $_ .= '/*';
- $_ .= <IN>;
- redo;
- }
- }
- if (s/^#\s*//) {
- if (s/^define\s+(\w+)//) {
- $name = $1;
- $new = '';
- s/\s+$//;
- if (s/^\(([\w,\s]*)\)//) {
- $args = $1;
- if ($args ne '') {
- foreach $arg (split(/,\s*/,$args)) {
- $curargs{$arg} = 1;
- }
- $args =~ s/\b(\w)/\$$1/g;
- $args = "local($args) = \@_;\n$t ";
- }
- s/^\s+//;
- do expr();
- $new =~ s/(["\\])/\\$1/g;
- if ($t ne '') {
- $new =~ s/(['\\])/\\$1/g;
- print OUT $t,
- "eval 'sub $name {\n$t ${args}eval \"$new\";\n$t}';\n";
- }
- else {
- print OUT "sub $name {\n ${args}eval \"$new\";\n}\n";
- }
- %curargs = ();
- }
- else {
- s/^\s+//;
- do expr();
- $new = 1 if $new eq '';
- if ($t ne '') {
- $new =~ s/(['\\])/\\$1/g;
- print OUT $t,"eval 'sub $name {",$new,";}';\n";
- }
- else {
- print OUT $t,"sub $name {",$new,";}\n";
- }
- }
- }
- elsif (/^include <(.*)>/) {
- print OUT $t,"do '$1' || die \"Can't include $1: \$!\";\n";
- }
- elsif (/^ifdef\s+(\w+)/) {
- print OUT $t,"if (defined &$1) {\n";
- $tab += 4;
- $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
- }
- elsif (/^ifndef\s+(\w+)/) {
- print OUT $t,"if (!defined &$1) {\n";
- $tab += 4;
- $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
- }
- elsif (s/^if\s+//) {
- $new = '';
- do expr();
- print OUT $t,"if ($new) {\n";
- $tab += 4;
- $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
- }
- elsif (s/^elif\s+//) {
- $new = '';
- do expr();
- $tab -= 4;
- $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
- print OUT $t,"}\n${t}elsif ($new) {\n";
- $tab += 4;
- $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
- }
- elsif (/^else/) {
- $tab -= 4;
- $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
- print OUT $t,"}\n${t}else {\n";
- $tab += 4;
- $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
- }
- elsif (/^endif/) {
- $tab -= 4;
- $t = "\t" x ($tab / 8) . ' ' x ($tab % 8);
- print OUT $t,"}\n";
- }
- }
- }
- print OUT "1;\n";
-}
-
-sub expr {
- while ($_ ne '') {
- s/^(\s+)// && do {$new .= ' '; next;};
- s/^(0x[0-9a-fA-F]+)// && do {$new .= $1; next;};
- s/^(\d+)// && do {$new .= $1; next;};
- s/^("(\\"|[^"])*")// && do {$new .= $1; next;};
- s/^'((\\"|[^"])*)'// && do {
- if ($curargs{$1}) {
- $new .= "ord('\$$1')";
- }
- else {
- $new .= "ord('$1')";
- }
- next;
- };
- s/^(struct\s+\w+)// && do {$new .= "'$1'"; next;};
- s/^sizeof\s*\(([^)]+)\)/{$1}/ && do {
- $new .= '$sizeof';
- next;
- };
- s/^([_a-zA-Z]\w*)// && do {
- $id = $1;
- if ($curargs{$id}) {
- $new .= '$' . $id;
- }
- elsif ($id eq 'defined') {
- $new .= 'defined';
- }
- elsif (/^\(/) {
- s/^\((\w),/("$1",/ if $id =~ /^_IO[WR]*$/; # cheat
- $new .= "&$id";
- }
- elsif ($isatype{$id}) {
- $new .= "'$id'";
- }
- else {
- $new .= '&' . $id;
- }
- next;
- };
- s/^(.)// && do {$new .= $1; next;};
- }
-}
-!NO!SUBS!
-chmod 755 makelib
-$eunicefix makelib
+echo "makelib.SH has been renamed to h2ph.SH"
+rm makelib
-#define PATCHLEVEL 21
+#define PATCHLEVEL 22
--- /dev/null
+#!/usr/bin/perl
+while (<>) {
+ if (/^\.SH SYNOPSIS/) {
+ $spec = '';
+ for ($_ = <>; $_ && !/^\.SH/; $_ = <>) {
+ s/^\.[IRB][IRB]\s*//;
+ s/^\.[IRB]\s+//;
+ next if /^\./;
+ s/\\f\w//g;
+ s/\\&//g;
+ s/^\s+//;
+ next if /^$/;
+ next if /^#/;
+ $spec .= $_;
+ }
+ $_ = $spec;
+ 0 while s/\(([^),;]*)\s*,\s*([^);]*)\)/($1|$2)/g;
+ s/\(\*([^,;]*)\)\(\)/(*)()$1/g;
+ s/(\w+)\[\]/*$1/g;
+
+ s/\n/ /g;
+ s/\s+/ /g;
+ s/(\w+) \(([^*])/$1($2/g;
+ s/^ //;
+ s/ ?; ?/\n/g;
+ s/\) /)\n/g;
+ s/ \* / \*/g;
+ s/\* / \*/g;
+
+ $* = 1;
+ 0 while s/^((struct )?\w+ )([^\n,]*), ?(.*)/$1$3\n$1$4/g;
+ $* = 0;
+ s/\|/,/g;
+
+ @cases = ();
+ for (reverse split(/\n/,$_)) {
+ if (/\)$/) {
+ ($type,$name,$args) = split(/(\w+)\(/);
+ $type =~ s/ $//;
+ if ($type =~ /^(\w+) =/) {
+ $type = $type{$1} if $type{$1};
+ }
+ $type = 'int' if $type eq '';
+ @args = grep(/./, split(/[,)]/,$args));
+ $case = "CASE $type $name\n";
+ foreach $arg (@args) {
+ $type = $type{$arg} || "int";
+ $type =~ s/ //g;
+ $type .= "\t" if length($type) < 8;
+ if ($type =~ /\*/) {
+ $case .= "IO $type $arg\n";
+ }
+ else {
+ $case .= "I $type $arg\n";
+ }
+ }
+ $case .= "END\n\n";
+ unshift(@cases, $case);
+ }
+ else {
+ $type{$name} = $type if ($type,$name) = /(.*\W)(\w+)$/;
+ }
+ }
+ print @cases;
+ }
+}
projects / p5sagit/p5-mst-13.2.git / commitdiff