dslinux/user/perl/h2pl README cbreak.pl cbreak2.pl getioctlsizes mksizes mkvars tcbreak tcbreak2

cayenne dslinux_cayenne at user.in-berlin.de
Mon Dec 4 17:59:52 CET 2006


Update of /cvsroot/dslinux/dslinux/user/perl/h2pl
In directory antilope:/tmp/cvs-serv17422/h2pl

Added Files:
	README cbreak.pl cbreak2.pl getioctlsizes mksizes mkvars 
	tcbreak tcbreak2 
Log Message:
Adding fresh perl source to HEAD to branch from

--- NEW FILE: tcbreak ---
#!/usr/bin/perl

require 'cbreak.pl';

&cbreak;

$| = 1;

print "gimme a char: ";

$c = getc;

print "$c\n";

printf "you gave me `%s', which is 0x%02x\n", $c, ord($c);

&cooked;

--- NEW FILE: mksizes ---
#!/usr/local/bin/perl

($iam = $0) =~ s%.*/%%;
$tmp = "$iam.$$";
open (CODE,">$tmp.c") || die "$iam: cannot create $tmp.c: $!\n";

$mask = q/printf ("$sizeof{'%s'} = %d;\n"/; 

# write C program
select(CODE);

print <<EO_C_PROGRAM;
#include <sys/param.h>
#include <sys/types.h>
#include <sys/socket.h>
#include <net/if_arp.h>
#include <net/if.h>
#include <net/route.h>
#include <sys/ioctl.h>

main() {
EO_C_PROGRAM

while ( <> ) {
    chop;
    printf "\t%s, \n\t\t\"%s\", sizeof(%s));\n", $mask, $_,$_;
}

print "\n}\n";

close CODE;

# compile C program

select(STDOUT);

system "cc $tmp.c -o $tmp";
die "couldn't compile $tmp.c" if $?;
system "./$tmp"; 	   
die "couldn't run $tmp" if $?;

unlink "$tmp.c", $tmp;

--- NEW FILE: mkvars ---
#!/usr/bin/perl

require 'sizeof.ph';

$LIB = '/usr/local/lib/perl';

foreach $include (@ARGV) {
    printf STDERR "including %s\n", $include;
    do $include;
    warn "sourcing $include: $@\n" if ($@);
    if (!open (INCLUDE,"$LIB/$include")) {
	warn "can't open $LIB/$include: $!\n"; 
	next; 
    } 
    while (<INCLUDE>) {
	chop;
	if (/^\s*eval\s+'sub\s+(\w+)\s.*[^{]$/ || /^\s*sub\s+(\w+)\s.*[^{]$/) {
	    $var = $1;
	    $val = eval "&$var;";
	    if ($@) {
		warn "$@: $_";
		print <<EOT;
warn "\$$var isn't correctly set" if defined \$_main{'$var'};
EOT
		next;
	    } 
	    ( $nval = sprintf ("%x",$val ) ) =~ tr/a-z/A-Z/;
	    printf "\$%s = 0x%s;\n", $var, $nval;
	} 
    }
} 

--- NEW FILE: cbreak2.pl ---
$sgttyb_t   = 'C4 S';

sub cbreak {
    &set_cbreak(1);
}

sub cooked {
    &set_cbreak(0);
}

sub set_cbreak {
    local($on) = @_;

    require 'sys/ioctl.pl';

    ioctl(STDIN,$TIOCGETP,$sgttyb)
        || die "Can't ioctl TIOCGETP: $!";

    @ary = unpack($sgttyb_t,$sgttyb);
    if ($on) {
        $ary[4] |= $CBREAK;
        $ary[4] &= ~$ECHO;
    } else {
        $ary[4] &= ~$CBREAK;
        $ary[4] |= $ECHO;
    }
    $sgttyb = pack($sgttyb_t, at ary);
    ioctl(STDIN,$TIOCSETP,$sgttyb)
            || die "Can't ioctl TIOCSETP: $!";

}

1;

--- NEW FILE: cbreak.pl ---
$sgttyb_t   = 'C4 S';

sub cbreak {
    &set_cbreak(1);
}

sub cooked {
    &set_cbreak(0);
}

sub set_cbreak {
    local($on) = @_;

    require 'sizeof.ph';
    require 'sys/ioctl.ph';

    ioctl(STDIN,&TIOCGETP,$sgttyb)
        || die "Can't ioctl TIOCGETP: $!";

    @ary = unpack($sgttyb_t,$sgttyb);
    if ($on) {
        $ary[4] |= &CBREAK;
        $ary[4] &= ~&ECHO;
    } else {
        $ary[4] &= ~&CBREAK;
        $ary[4] |= &ECHO;
    }
    $sgttyb = pack($sgttyb_t, at ary);
    ioctl(STDIN,&TIOCSETP,$sgttyb)
            || die "Can't ioctl TIOCSETP: $!";

}

1;

--- NEW FILE: README ---
[This file of Tom Christiansen's has been edited to change makelib to h2ph
and .h to .ph where appropriate--law.]

This directory contains files to help you convert the *.ph files generated my
h2ph out of the perl source directory into *.pl files with all the
indirection of the subroutine calls removed.  The .ph version will be more
safely portable, because if something isn't defined on the new system, like
&TIOCGETP, then you'll get a fatal run-time error on the system lacking that
function.  Using the .pl version means that the subsequent scripts will give
you a 0 $TIOCGETP and God only knows what may then happen.   Still, I like the
.pl stuff because they're faster to load.

FIrst, you need to run h2ph on things like sys/ioctl.h to get stuff
into the perl library directory, often /usr/local/lib/perl.  For example,
    # h2ph sys/ioctl.h
takes /usr/include/sys/ioctl.h as input and writes (without i/o redirection)
the file /usr/local/lib/perl/sys/ioctl.ph, which looks like this

    eval 'sub TIOCM_RTS {0004;}';
    eval 'sub TIOCM_ST {0010;}';
    eval 'sub TIOCM_SR {0020;}';
    eval 'sub TIOCM_CTS {0040;}';
    eval 'sub TIOCM_CAR {0100;}';

and much worse, rather than what Larry's ioctl.pl from the perl source dir has, 
which is:

    $TIOCM_RTS = 0004;
    $TIOCM_ST = 0010;
    $TIOCM_SR = 0020;
    $TIOCM_CTS = 0040;
    $TIOCM_CAR = 0100;

[Workaround for fixed bug in makedir/h2ph deleted--law.]

The more complicated ioctl subs look like this:

    eval 'sub TIOCGSIZE {&TIOCGWINSZ;}';
    eval 'sub TIOCGWINSZ {&_IOR("t", 104, \'struct winsize\');}';
    eval 'sub TIOCSETD {&_IOW("t", 1, \'int\');}';
    eval 'sub TIOCGETP {&_IOR("t", 8,\'struct sgttyb\');}';

The _IO[RW] routines use a %sizeof array, which (presumably) 
is keyed on the type name with the value being the size in bytes.  

To build %sizeof, try running this in this directory:

    % ./getioctlsizes 

Which will tell you which things the %sizeof array needs
to hold.  You can try to build a sizeof.ph file with:

    % ./getioctlsizes | ./mksizes > sizeof.ph

Note that mksizes hardcodes the #include files for all the types, so it will
probably require customization.  Once you have sizeof.ph, install it in the
perl library directory.  Run my tcbreak script to see whether you can do
ioctls in perl now.  You'll get some kind of fatal run-time error if you
can't.  That script should be included in this directory.

If this works well, now you can try to convert the *.ph files into
*.pl files.  Try this:

    foreach file ( sysexits.ph sys/{errno.ph,ioctl.ph} )
	./mkvars $file > t/$file:r.pl
    end

The last one will be the hardest.  If it works, should be able to 
run tcbreak2 and have it work the same as tcbreak.

Good luck.

--- NEW FILE: tcbreak2 ---
#!/usr/bin/perl

require 'cbreak2.pl';

&cbreak;

$| = 1;

print "gimme a char: ";

$c = getc;

print "$c\n";

printf "you gave me `%s', which is 0x%02x\n", $c, ord($c);

&cooked;

--- NEW FILE: getioctlsizes ---
#!/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";
} 




More information about the dslinux-commit mailing list