os

gistfile1.txt

#!/usr/bin/env perl6

module OS {
    our $debug is export = 0;

    sub debug(Str $msg) { note "DEBUG :::::: $msg" if $debug; }

    sub yield(|c) is export { take c[0]; }

    role SystemCall {
        has $.data;
        has $.ret;

        multi method new(\data, \ret) {
            self.bless()!init-data(data)!init-ret(ret);
        }

        multi method new() {
            self.bless();
        }

        method !init-data(\data) {
            $!data := data;
            self;
        }

        method !init-ret(\ret) {
            $!ret := ret;
            self;
        }

        method set-ret(\ret) {
            $!ret = ret;
         }

        method call($task, $scheduler) { ... }
    }

    multi sub systemcall(SystemCall:U $type, \d, \r, *@args) is export {
        yield $type.new(d, r, @args);
    }

    multi sub systemcall(SystemCall:U $type, \d, \r) is export {
        yield $type.new(d, r);
    }

    multi sub systemcall(SystemCall:U $type, \d) is export {
        yield $type.new(d);
    }

    multi sub systemcall(SystemCall:U $type) is export {
        yield $type.new();
    }

    class GetTid does SystemCall {
        multi method new(\ret) {
            self.bless()!init-ret(ret);
        }

        method call($task, $scheduler) {
            self.set-ret($task.id);
            &debug("GetTid ==> {$!ret}");
            $scheduler.scheduler($task);
        }
    }

    class NewTask does SystemCall {
        has @.args;

        multi method new(\data, \ret, @args) {
            self.bless(:@args)!init-data(data)!init-ret(ret);
        }

        method call($task, $scheduler) {
            self.set-ret($scheduler.cue(&$!data, @!args));
            &debug("Create task<< {&$!data.perl} >> ==> {$!ret}");
            $scheduler.scheduler($task);
        }
    }

    class KillTask does SystemCall {
        multi method new(\data) {
            self.bless()!init-data(data);
        }
        method call($task, $scheduler) {
            self.set-ret(do {
                with $scheduler.get($!data) {
                    .say;
                    .kill();
                    True
                } else {
                    False
                }
            });
            &debug("Kill task {$!data}");
            $scheduler.scheduler($task);
        }
    }

    class WaitForTask does SystemCall {
        multi method new(\data) {
            self.bless()!init-data(data);
        }
        method call($task, $scheduler) {
            self.set-ret($scheduler.wait-for-exit($task, $!data));
            unless $!ret {
                $scheduler.scheduler($task);
            }
        }
    }

    class Task {
        my $taskid = 0;

        has $.id;
        has $.target;
        has $.send;

        method new(&target, @args) {
            my $target = lazy gather &target(|@args);
            self.bless(id => ++$taskid, target => $target.iterator, send => Nil);
        }

        method run() {
            return $!target.pull-one;
        }

        method kill() {
            $!target = class :: {
                method pull-one() {
                    IterationEnd;
                }
            }.new;
        }
    }

    sub fake-async-read($file, Int $size) is export {
        my $data;
        my $p = start { $data = $file.recv($size, :bin); }
        while $p.status ~~ Planned {
            yield;
        }
        return $p.status ~~ Broken ?? False !! $data;
    }

    sub fake-async-write($file, $data) is export {
        my $p = start { $file.write($data); }
        while $p.status ~~ Planned {
            yield;
        }
        return $p.status ~~ Kept;
    }

    sub fake-async-accept($server) is export {
        my $c;
        my $p = start { $c = $server.accept; }
        while $p.status ~~ Planned {
            yield;
        }
        return $p.status ~~ Broken ?? False !! $c;
    }

    class Scheduler {
        has @!ready;
        has %!task;
        has %!exit_waiting;

        method cue(&code, @args = []) {
            my $task = Task.new(&code, @args);
            %!task{$task.id} = $task;
            self.scheduler($task);
            return $task.id;
        }

        method get(Int $id) {
            %!task{$id};
        }

        method scheduler(Task $task) {
            @!ready.push($task);
        }

        method exit(Task $task) {
            %!task{$task.id}:delete;
            if %!exit_waiting{$task.id}:exists {
                for @(%!exit_waiting{$task.id}:delete) {
                    self.scheduler($_);
                }
            }
        }

        method wait-for-exit(Task $task, $id) {
            if %!task{$id}:exists {
                (%!exit_waiting{$id} //= []).push($task);
                True;
            } else {
                False;
            }
        }

        method main-loop() {
            while %!task {
                my $task = @!ready.shift;
                try {
                    my $result := $task.run;
                    &debug("Task {$task.id} run") with $result;
                    if so try $result ~~ IterationEnd {
                        self.exit($task);
                    } elsif so try $result ~~ SystemCall {
                        $result.call($task, self);
                        next;
                    }
                    CATCH {
                        default {
                            .say;
                        }
                    }
                }
                self.scheduler($task);
            }
        }
    }
}

import OS;

sub MAIN(Bool :d($debug)) {
    $OS::debug = $debug;

    my $scheduler = OS::Scheduler.new;

    sub handle-client($client) {
        say "Connection from ", $client;
        while True {
            my $data = fake-async-read($client, 65536);
            last if (!$data) || (!fake-async-write($client, $data));
        }
        say "Connection closed";
        yield;
    }

    sub server($port) {
        say "Server starting";
        my $server = IO::Socket::INET.new(localport => $port, :listen);
        my $c;

        while True {
            $c = fake-async-accept($server);
            last if not $c;
            systemcall(OS::NewTask, &handle-client, my $id, $c);
        }
    }
    #$scheduler.cue(-> { while True { say "I am alive!"; yield; } });
    $scheduler.cue(&server, [18833, ]);
    $scheduler.main-loop;
}