Last active
December 19, 2016 13:45
-
-
Save blippy/8c3be33c5762fa5f529865e30f8d5e20 to your computer and use it in GitHub Desktop.
Perl6 forks and pipes
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
use NativeCall; | |
# http://www.perlmonks.org/?node_id=989766 | |
our sub c_close(int32) returns int32 is native is symbol('close') { * } | |
our sub c_fork() returns int32 is native is symbol('fork') { ... }; | |
our sub c_pipe(CArray[int32]) returns int32 is native is symbol('pipe') { ... } | |
our sub c_puts(Str) is native is symbol("puts") { * } | |
our sub c_read(int32, CArray[uint8], size_t) returns ssize_t is native is symbol('read') { *} | |
our sub c_wait(int32 is rw) is native is symbol('wait') { * } | |
our sub c_waitpid(int32, Pointer, int32) returns int32 is native is symbol('waitpid') {*}; | |
our sub c_write(int32, Str is encoded('utf8'), size_t) returns ssize_t is native is symbol('write') { *} | |
my @fd := CArray[int32].new(0, 0); | |
my $pok = c_pipe(@fd); | |
if ($pok == -1) { die "Pipe failed" ; } | |
# See: | |
# https://rosettacode.org/wiki/Fork#Perl_6 | |
my $pid = c_fork(); | |
if ( $pid < 0) { die "Fork failed" ; } | |
if ( $pid == 0) { | |
print "C: I am the child\n"; | |
if (c_close(@fd[1]) == -1) { die "Child couldn't close fd[1]" }; | |
my uint8 $b0 = 0; | |
my @buf := CArray[uint8].new( $b0 xx 80); | |
say "C: starting read"; | |
my $nread = c_read(@fd[0], @buf, 80); | |
print "C: nread=$nread\n"; | |
my $msg = ""; | |
for (0..$nread-1) -> $i { $msg = $msg ~ chr(@buf[$i]); } ; | |
print "C: message:$msg.\n"; | |
c_close(@fd[0]); | |
} else { | |
print "P: I am the parent of $pid\n"; | |
if (c_close(@fd[0]) == -1) { die "Parent couldn't close fd[0]"; } ; | |
my $msg = "Hello from parent"; | |
my $len = $msg.encode('utf8').bytes; | |
print "P: test put string: "; | |
c_puts($msg); | |
my $nwritten =c_write(@fd[1], $msg, $len); | |
print "P: len $len, wrote $nwritten\n"; | |
say "P: Finished writing"; | |
c_close(@fd[1]); | |
my $stat_loc; | |
c_waitpid($pid, $stat_loc ,0); | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Discussed on stackoverflow.