Merge jvm socket code into main impl and fix bugs

src/core/IO/Socket.pm

@@ -1,12 +1,18 @@
 my role IO::Socket does IO {
-#?if parrot
     has $!PIO;
-    has $!buffer = '';
+    has $!buffer =
+#?if parrot
+        '';
+#?endif
+#?if !parrot
+        buf8.new;
+#?endif
 
     # if bin is true, will return Buf, Str otherwise
     method recv (Cool $chars = $Inf, :$bin? = False) {
         fail('Socket not available') unless $!PIO;
 
+#?if parrot
         if $!buffer.chars < $chars {
             my str $r = $!PIO.recv;
             unless $bin {
@@ -32,10 +38,40 @@ my role IO::Socket does IO {
         else {
             $rec
         }
+#?endif
+#?if !parrot
+        if $!buffer.elems < $chars {
+            my $r := nqp::readfh($!PIO, nqp::decont(buf8.new), 512);
+            $!buffer ~= $r;
+        }
+
+        if $bin {
+            my $rec;
+            if $!buffer.elems > $chars {
+                $rec = $!buffer.subbuf(0, $chars);
+                $!buffer = $!buffer.subbuf($chars);
+            } else {
+                $rec = $!buffer;
+                $!buffer = buf8.new;
+            }
+            $rec;
+        } else {
+            my $rec = nqp::decode(nqp::decont($!buffer), 'utf8');
+            if $rec.chars > $chars {
+                $rec = $rec.substr(0, $chars);
+                my $used = $rec.encode('utf8').elems;
+                $!buffer = $!buffer.subbuf($used)
+            } else {
+                $!buffer = buf8.new;
+            }
+            $rec;
+        }
+#?endif
     }
 
     method read(IO::Socket:D: Cool $bufsize as Int) {
         fail('Socket not available') unless $!PIO;
+#?if parrot            
         my str $res;
         my str $read;
         repeat {
@@ -45,28 +81,61 @@ my role IO::Socket does IO {
             $res = nqp::concat($res, $read);
         } while nqp::chars($res) < $bufsize && nqp::chars($read);
         nqp::encode(nqp::unbox_s($res), 'binary', buf8.new);
+#?endif
+#?if !parrot
+        my $res = buf8.new();
+        my $buf;
+        repeat {
+            $buf := buf8.new();
+            nqp::readfh($!PIO, $buf, nqp::unbox_i($bufsize - $res.elems));
+            $res ~= $buf;
+        } while $res.elems < $bufsize && $buf.elems;
+        $res;
+#?endif
     }
 
     method poll(Int $bitmask, $seconds) {
+#?if parrot
         $!PIO.poll(
             nqp::unbox_i($bitmask), nqp::unbox_i($seconds.floor),
             nqp::unbox_i((($seconds - $seconds.floor) * 1000).Int)
         );
+#?endif
+#?if !parrot
+        die 'Socket.poll is NYI on this backend'
+#?endif
     }
 
     method send (Cool $string as Str) {
         fail("Not connected") unless $!PIO;
+#?if parrot
         $!PIO.send(nqp::unbox_s($string)).Bool;
+#?endif
+#?if !parrot
+        nqp::printfh($!PIO, nqp::unbox_s($string));
+        True
+#?endif
     }
 
     method write(Blob:D $buf) {
         fail('Socket not available') unless $!PIO;
+#?if parrot
         $!PIO.send(nqp::decode(nqp::decont($buf), 'binary')).Bool;
+#?endif
+#?if !parrot
+        nqp::writefh($!PIO, nqp::decont($buf));
+        True
+#?endif
     }
 
     method close () {
         fail("Not connected!") unless $!PIO;
+#?if parrot
         $!PIO.close().Bool
-    }
 #?endif
+#?if !parrot
+        nqp::closefh($!PIO);
+        True
+#?endif
+    }
 }

src/core/IO/Socket/INET.pm

@@ -1,5 +1,4 @@
 my class IO::Socket::INET does IO::Socket {
-#?if parrot
     my module PIO {
         constant PF_LOCAL       = 0;
         constant PF_UNIX        = 1;
@@ -67,30 +66,48 @@ my class IO::Socket::INET does IO::Socket {
     }
 
     method !initialize() {
+#?if parrot
         my $PIO := Q:PIR { %r = root_new ['parrot';'Socket'] };
         $PIO.socket($.family, $.type, $.proto);        
-        
+#?endif
+#?if !parrot
+        my $PIO := nqp::socket($.listen ?? 10 !! 0);
+#?endif
         #Quoting perl5's SIO::INET:
         #If Listen is defined then a listen socket is created, else if the socket type, 
         #which is derived from the protocol, is SOCK_STREAM then connect() is called.
         if $.listen || $.localhost || $.localport {
+#?if parrot
             my $addr := $PIO.sockaddr($.localhost || "0.0.0.0", $.localport || 0);
             $PIO.bind($addr);
+#?endif
+#?if !parrot
+            nqp::bindsock($PIO, nqp::unbox_s($.localhost || "0.0.0.0"),
+                                 nqp::unbox_i($.localport || 0));
+#?endif
         }
 
-        if $.listen { 
+        if $.listen {
+#?if parrot
             $PIO.listen($.listen);
+#?endif
         }
         elsif $.type == PIO::SOCK_STREAM {
+#?if parrot
             my $addr := $PIO.sockaddr($.host, $.port);
             $PIO.connect($addr);
+#?endif
+#?if !parrot
+            my $addr := nqp::connect($PIO, nqp::unbox_s($.host), nqp::unbox_i($.port));
+#?endif
         }
 
         nqp::bindattr(self, $?CLASS, '$!PIO', $PIO);
         self;
     }
 
     method get() {
+#?if parrot
         my str $encoding = nqp::unbox_s(NORMALIZE_ENCODING($!encoding));
         my str $sep = pir::trans_encoding__SSI(
             nqp::unbox_s($!input-line-separator),
@@ -101,6 +118,16 @@ my class IO::Socket::INET does IO::Socket {
         $PIO.encoding($encoding);
 
         my str $line = $PIO.readline($sep);
+#?endif
+#?if !parrot
+        my str $sep = nqp::unbox_s($!input-line-separator);
+        my int $sep-len = nqp::chars($sep);
+
+        my Mu $io := nqp::getattr(self, $?CLASS, '$!PIO');
+        nqp::setencoding($io, nqp::unbox_s($!encoding));
+        nqp::setinputlinesep($io, $sep);
+        my Str $line = nqp::p6box_s(nqp::readlinefh($io));
+#?endif
         my int $len  = nqp::chars($line);
 
         if $len == 0 { Str }
@@ -119,20 +146,35 @@ my class IO::Socket::INET does IO::Socket {
     }
 
     method accept() {
-        #my $new_sock := nqp::create($?CLASS);
         ## A solution as proposed by moritz
         my $new_sock := $?CLASS.bless(:$!family, :$!proto, :$!type, :$!input-line-separator);
-        nqp::getattr($new_sock, $?CLASS, '$!buffer') = '';
-        nqp::bindattr($new_sock, $?CLASS, '$!PIO', nqp::getattr(self, $?CLASS, '$!PIO').accept());
+        nqp::getattr($new_sock, $?CLASS, '$!buffer') =
+#?if parrot
+            '';
+#?endif
+#?if !parrot
+            buf8.new;
+#?endif
+        nqp::bindattr($new_sock, $?CLASS, '$!PIO',
+#?if parrot
+            nqp::getattr(self, $?CLASS, '$!PIO').accept()
+#?endif
+#?if !parrot
+            nqp::accept(nqp::getattr(self, $?CLASS, '$!PIO'))
+#?endif
+        );
         return $new_sock;
     }
 
     method remote_address() {
+#?if parrot
         return nqp::p6box_s(nqp::getattr(self, $?CLASS, '$!PIO').remote_address());
+#?endif
     }
 
     method local_address() {
+#?if parrot
         return nqp::p6box_s(nqp::getattr(self, $?CLASS, '$!PIO').local_address());
-    }
 #?endif
+    }
 }

src/core/control.pm

@@ -181,7 +181,10 @@ sub run(*@args ($, *@)) {
         ) +> 8;
 #?endif
 #?if !parrot
-        die "run is NYI on non-Parrot backend";
+        my Mu $hash := nqp::getattr(%*ENV, EnumMap, '$!storage');
+        $error_code = nqp::p6box_i(
+            nqp::spawn(nqp::getattr(@args.eager, List, '$!items'), $*CWD.Str, $hash)
+        ) +> 8;
 #?endif
         CATCH {
             default {
@@ -196,7 +199,7 @@ sub shell($cmd) {
     my $status = 255;
     try {
         my Mu $hash := nqp::getattr(%*ENV, EnumMap, '$!storage');
-        $status = nqp::shell($cmd, $*CWD.Str, $hash);
+        $status = nqp::p6box_i(nqp::shell($cmd, $*CWD.Str, $hash));
     }
     $status;
 }
@@ -246,12 +249,22 @@ sub interval($seconds ) {       # fractional seconds also allowed
 }
 
 sub QX($cmd) {
-    my Mu $pio := nqp::open(nqp::unbox_s($cmd), 'rp');
+#?if parrot    
+    my Mu $pio := nqp::open(nqp::unbox_s($cmd), 'rp');    
     fail "Unable to execute '$cmd'" unless $pio;
     $pio.encoding('utf8');
     my $result = nqp::p6box_s($pio.readall());
     $pio.close();
     $result;
+#?endif
+#?if !parrot
+    my Mu $env := nqp::getattr(%*ENV, EnumMap, '$!storage');
+    my Mu $pio := nqp::openpipe(nqp::unbox_s($cmd), $*CWD.Str, $env, '');
+    fail "Unable to execute '$cmd'" unless $pio;
+    my $result = nqp::p6box_s(nqp::readallfh($pio));
+    nqp::closefh($pio);
+    $result;
+#?endif    
 }
 
 sub EXHAUST(|) {