Skip to content

Commit

Permalink
Use new nqp::syscall/register/delegate ops
Browse files Browse the repository at this point in the history 
Instead of their long nqp::dispatch(....) versions
  • Loading branch information
@lizmat
lizmat committed Jan 11, 2024
1 parent 690c6c0 commit becb682
Show file tree
Hide file tree
Showing 11 changed files with 982 additions and 1,000 deletions.
125 changes: 62 additions & 63 deletions lib/NativeCall/Dispatcher.rakumod
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,47 +5,47 @@ use nqp;
my sub raku-nativecall-deproxy(Mu $capture is raw) {
my $callee := nqp::captureposarg($capture, 1);
# The resume init state drops the remover.
nqp::dispatch('boot-syscall', 'dispatcher-set-resume-init-args',
nqp::dispatch('boot-syscall', 'dispatcher-drop-arg', $capture, 0));
nqp::syscall('dispatcher-set-resume-init-args',
nqp::syscall('dispatcher-drop-arg', $capture, 0));

# We then invoke the remover with the arguments (so need to drop the
# original invokee).
nqp::dispatch('boot-syscall', 'dispatcher-delegate', 'boot-code-constant',
nqp::dispatch('boot-syscall', 'dispatcher-drop-arg', $capture, 1));
nqp::delegate('boot-code-constant',
nqp::syscall('dispatcher-drop-arg', $capture, 1));
}

my sub raku-nativecall-deproxy-resume(Mu $capture is raw) {
my $track_kind := nqp::dispatch('boot-syscall', 'dispatcher-track-arg', $capture, 0);
nqp::dispatch('boot-syscall', 'dispatcher-guard-literal', $track_kind);
my $track_kind := nqp::syscall('dispatcher-track-arg', $capture, 0);
nqp::syscall('dispatcher-guard-literal', $track_kind);
my int $kind = nqp::captureposarg_i($capture, 0);

if $kind == nqp::const::DISP_DECONT {
my $orig-capture := nqp::dispatch('boot-syscall', 'dispatcher-get-resume-init-args');
my $track_callee := nqp::dispatch('boot-syscall', 'dispatcher-track-arg',
my $orig-capture := nqp::syscall('dispatcher-get-resume-init-args');
my $track_callee := nqp::syscall('dispatcher-track-arg',
$orig-capture, 0);
nqp::dispatch('boot-syscall', 'dispatcher-guard-literal', $track_callee);
nqp::syscall('dispatcher-guard-literal', $track_callee);
my $callee := nqp::captureposarg($orig-capture, 0);
my $capture-delegate := nqp::dispatch('boot-syscall',
'dispatcher-insert-arg-literal-obj',
nqp::dispatch('boot-syscall', 'dispatcher-drop-arg', $capture, 0), 0, $callee);
nqp::dispatch('boot-syscall', 'dispatcher-delegate', 'raku-nativecall-core', $capture-delegate);
my $capture-delegate := nqp::syscall(
'dispatcher-insert-arg-literal-obj',
nqp::syscall('dispatcher-drop-arg', $capture, 0), 0, $callee);
nqp::delegate('raku-nativecall-core', $capture-delegate);
}
}

my $do := nqp::getattr(&raku-nativecall-deproxy, Code, '$!do');
nqp::forceouterctx($do, nqp::getattr(MY::, PseudoStash, '$!ctx'));
my $do-resume := nqp::getattr(&raku-nativecall-deproxy-resume, Code, '$!do');
nqp::forceouterctx($do-resume, nqp::getattr(MY::, PseudoStash, '$!ctx'));
nqp::dispatch('boot-syscall', 'dispatcher-register', 'raku-nativecall-deproxy', $do, $do-resume);
nqp::register('raku-nativecall-deproxy', $do, $do-resume);

my $PROXY-READERS := nqp::gethllsym('Raku', 'PROXY-READERS');
my sub raku-nativecall(Mu $capture is raw) {
my $track_callee := nqp::dispatch('boot-syscall', 'dispatcher-track-arg', $capture, 0);
nqp::dispatch('boot-syscall', 'dispatcher-guard-literal', $track_callee);
my $track_callee := nqp::syscall('dispatcher-track-arg', $capture, 0);
nqp::syscall('dispatcher-guard-literal', $track_callee);
my $callee := nqp::captureposarg($capture, 0);
$callee.setup;

my Mu $args := nqp::dispatch('boot-syscall', 'dispatcher-drop-arg', $capture, 0);
my Mu $args := nqp::syscall('dispatcher-drop-arg', $capture, 0);
my int $pos-args = nqp::captureposelems($args);
my int $i = 0;

Expand All @@ -70,8 +70,8 @@ my sub raku-nativecall(Mu $capture is raw) {
$i = 0;
while $i < $pos-args {
if nqp::captureposprimspec($args, $i) == 0 {
my $track-arg := nqp::dispatch('boot-syscall', 'dispatcher-track-arg', $args, nqp::unbox_i($i));
nqp::dispatch('boot-syscall', 'dispatcher-guard-type', $track-arg);
my $track-arg := nqp::syscall('dispatcher-track-arg', $args, nqp::unbox_i($i));
nqp::syscall('dispatcher-guard-type', $track-arg);
}
$i++;
}
Expand All @@ -81,67 +81,67 @@ my sub raku-nativecall(Mu $capture is raw) {
# and delegate to a dispatcher to manage reading the args and
# then retrying with the outcome.
my $reader := $PROXY-READERS.reader-for($args, $non-scalar);
my $capture-delegate := nqp::dispatch('boot-syscall',
'dispatcher-insert-arg-literal-obj', $capture, 0, nqp::getattr($reader, Code, '$!do'));
nqp::dispatch('boot-syscall', 'dispatcher-delegate', 'raku-nativecall-deproxy',
$capture-delegate);
my $capture-delegate := nqp::syscall(
'dispatcher-insert-arg-literal-obj',
$capture, 0, nqp::getattr($reader, Code, '$!do'));
nqp::delegate('raku-nativecall-deproxy', $capture-delegate);
return;
}

nqp::dispatch('boot-syscall', 'dispatcher-delegate', 'raku-nativecall-core', $capture);
nqp::delegate('raku-nativecall-core', $capture);
}
$do := nqp::getattr(&raku-nativecall, Code, '$!do');
nqp::forceouterctx($do, nqp::getattr(MY::, PseudoStash, '$!ctx'));
nqp::dispatch('boot-syscall', 'dispatcher-register', 'raku-nativecall', $do);
nqp::register('raku-nativecall', $do);

my sub raku-nativecall-core(Mu $capture is raw) {
my $callee := nqp::captureposarg($capture, 0);

my Mu $args := nqp::dispatch('boot-syscall', 'dispatcher-drop-arg', $capture, 0);
my Mu $args := nqp::syscall('dispatcher-drop-arg', $capture, 0);
my int $pos-args = nqp::captureposelems($args);
my int $i = 0;
while $i < $pos-args {
# If it should be passed read only, and it's an object...
if nqp::captureposprimspec($args, $i) == 0 {
# If it's in a Scalar container...
my $track-arg := nqp::dispatch('boot-syscall', 'dispatcher-track-arg', $args, nqp::unbox_i($i));
nqp::dispatch('boot-syscall', 'dispatcher-guard-type', $track-arg);
nqp::dispatch('boot-syscall', 'dispatcher-guard-concreteness', $track-arg);
my $track-arg := nqp::syscall('dispatcher-track-arg', $args, nqp::unbox_i($i));
nqp::syscall('dispatcher-guard-type', $track-arg);
nqp::syscall('dispatcher-guard-concreteness', $track-arg);
my $arg := nqp::captureposarg($args, $i);
my $track-value;
my $cstr = False;
if nqp::isconcrete_nd($arg) && nqp::istype_nd($arg, Scalar) {
# Read it from the container and pass it decontainerized.
$track-value := nqp::dispatch('boot-syscall', 'dispatcher-track-attr',
$track-value := nqp::syscall('dispatcher-track-attr',
$track-arg, Scalar, '$!value');
$args := nqp::dispatch('boot-syscall', 'dispatcher-insert-arg',
nqp::dispatch('boot-syscall', 'dispatcher-drop-arg', $args, nqp::unbox_i($i)),
$args := nqp::syscall('dispatcher-insert-arg',
nqp::syscall('dispatcher-drop-arg', $args, nqp::unbox_i($i)),
nqp::unbox_i($i), $track-value);
$arg := nqp::decont($arg);
}
else {
$track-value := $track-arg;
}
if nqp::isconcrete_nd($arg) && nqp::istype_nd($arg, Code) {
$track-value := nqp::dispatch('boot-syscall', 'dispatcher-track-attr',
$track-value := nqp::syscall('dispatcher-track-attr',
$track-value, Code, '$!do');
$args := nqp::dispatch('boot-syscall', 'dispatcher-insert-arg',
nqp::dispatch('boot-syscall', 'dispatcher-drop-arg', $args, nqp::unbox_i($i)),
$args := nqp::syscall('dispatcher-insert-arg',
nqp::syscall('dispatcher-drop-arg', $args, nqp::unbox_i($i)),
nqp::unbox_i($i), $track-value);
}
if nqp::isconcrete_nd($arg) && $arg.does(NativeCall::Types::ExplicitlyManagedString) {
$cstr = True;
$track-value := nqp::dispatch('boot-syscall', 'dispatcher-track-attr',
$track-value := nqp::syscall('dispatcher-track-attr',
$track-value, $arg.WHAT, '$!cstr');
$args := nqp::dispatch('boot-syscall', 'dispatcher-insert-arg',
nqp::dispatch('boot-syscall', 'dispatcher-drop-arg', $args, nqp::unbox_i($i)),
$args := nqp::syscall('dispatcher-insert-arg',
nqp::syscall('dispatcher-drop-arg', $args, nqp::unbox_i($i)),
nqp::unbox_i($i), $track-value);
$arg := nqp::getattr($arg, $arg.WHAT, '$!cstr');
if nqp::isconcrete_nd($arg) && nqp::what_nd($arg) =:= Scalar {
$track-value := nqp::dispatch('boot-syscall', 'dispatcher-track-attr',
$track-value := nqp::syscall('dispatcher-track-attr',
$track-value, Scalar, '$!value');
$args := nqp::dispatch('boot-syscall', 'dispatcher-insert-arg',
nqp::dispatch('boot-syscall', 'dispatcher-drop-arg', $args, nqp::unbox_i($i)),
$args := nqp::syscall('dispatcher-insert-arg',
nqp::syscall('dispatcher-drop-arg', $args, nqp::unbox_i($i)),
nqp::unbox_i($i), $track-value);
$arg := nqp::decont($arg);
}
Expand All @@ -151,43 +151,43 @@ my sub raku-nativecall-core(Mu $capture is raw) {
unless $param.rw or nqp::isrwcont($arg) {
if $param.type ~~ Int or $param.type.REPR eq 'CPointer' {
if nqp::isconcrete_nd($arg) {
$track-value := nqp::dispatch('boot-syscall', 'dispatcher-track-unbox-int',
$track-value := nqp::syscall('dispatcher-track-unbox-int',
$track-value);
$args := nqp::dispatch('boot-syscall', 'dispatcher-insert-arg',
nqp::dispatch('boot-syscall', 'dispatcher-drop-arg', $args, nqp::unbox_i($i)),
$args := nqp::syscall('dispatcher-insert-arg',
nqp::syscall('dispatcher-drop-arg', $args, nqp::unbox_i($i)),
nqp::unbox_i($i), $track-value);
}
else {
$args := nqp::dispatch('boot-syscall', 'dispatcher-insert-arg-literal-int',
nqp::dispatch('boot-syscall', 'dispatcher-drop-arg', $args, nqp::unbox_i($i)),
$args := nqp::syscall('dispatcher-insert-arg-literal-int',
nqp::syscall('dispatcher-drop-arg', $args, nqp::unbox_i($i)),
nqp::unbox_i($i), 0); # 0 or NULL for undefined args
}
}
elsif $param.type ~~ Num {
if nqp::isconcrete_nd($arg) {
$track-value := nqp::dispatch('boot-syscall', 'dispatcher-track-unbox-num',
$track-value := nqp::syscall('dispatcher-track-unbox-num',
$track-value);
$args := nqp::dispatch('boot-syscall', 'dispatcher-insert-arg',
nqp::dispatch('boot-syscall', 'dispatcher-drop-arg', $args, nqp::unbox_i($i)),
$args := nqp::syscall('dispatcher-insert-arg',
nqp::syscall('dispatcher-drop-arg', $args, nqp::unbox_i($i)),
nqp::unbox_i($i), $track-value);
}
else {
$args := nqp::dispatch('boot-syscall', 'dispatcher-insert-arg-literal-num',
nqp::dispatch('boot-syscall', 'dispatcher-drop-arg', $args, nqp::unbox_i($i)),
$args := nqp::syscall('dispatcher-insert-arg-literal-num',
nqp::syscall('dispatcher-drop-arg', $args, nqp::unbox_i($i)),
nqp::unbox_i($i), NaN);
}
}
elsif $param.type ~~ Str and not $cstr {
if nqp::isconcrete_nd($arg) {
$track-value := nqp::dispatch('boot-syscall', 'dispatcher-track-unbox-str',
$track-value := nqp::syscall('dispatcher-track-unbox-str',
$track-value);
$args := nqp::dispatch('boot-syscall', 'dispatcher-insert-arg',
nqp::dispatch('boot-syscall', 'dispatcher-drop-arg', $args, nqp::unbox_i($i)),
$args := nqp::syscall('dispatcher-insert-arg',
nqp::syscall('dispatcher-drop-arg', $args, nqp::unbox_i($i)),
nqp::unbox_i($i), $track-value);
}
else {
$args := nqp::dispatch('boot-syscall', 'dispatcher-insert-arg-literal-int',
nqp::dispatch('boot-syscall', 'dispatcher-drop-arg', $args, nqp::unbox_i($i)),
$args := nqp::syscall('dispatcher-insert-arg-literal-int',
nqp::syscall('dispatcher-drop-arg', $args, nqp::unbox_i($i)),
nqp::unbox_i($i), 0); # NULL for undefined args
}
}
Expand All @@ -196,14 +196,13 @@ my sub raku-nativecall-core(Mu $capture is raw) {
$i++;
}

my $new_capture := nqp::dispatch('boot-syscall',
'dispatcher-insert-arg-literal-obj',
$args, 0, nqp::decont($callee.rettype));
my $delegate_capture := nqp::dispatch('boot-syscall', 'dispatcher-insert-arg-literal-obj',
$new_capture, 0, $callee.call);
nqp::dispatch('boot-syscall', 'dispatcher-delegate', 'boot-foreign-code', $delegate_capture);
my $new_capture := nqp::syscall( 'dispatcher-insert-arg-literal-obj',
$args, 0, nqp::decont($callee.rettype));
my $delegate_capture := nqp::syscall('dispatcher-insert-arg-literal-obj',
$new_capture, 0, $callee.call);
nqp::delegate('boot-foreign-code', $delegate_capture);
};

$do := nqp::getattr(&raku-nativecall-core, Code, '$!do');
nqp::forceouterctx($do, nqp::getattr(MY::, PseudoStash, '$!ctx'));
nqp::dispatch('boot-syscall', 'dispatcher-register', 'raku-nativecall-core', $do);
nqp::register('raku-nativecall-core', $do);
5 changes: 4 additions & 1 deletion src/Perl6/Actions.nqp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6764,7 +6764,10 @@ class Perl6::Actions is HLL::Actions does STDActions {
$i := $i + 2;
}
}
elsif $op eq 'dispatch' {
elsif $op eq 'dispatch'
|| $op eq 'syscall'
|| $op eq 'register'
|| $op eq 'delegate' {
# We generally want to send unboxed string/int values in for dispatch
# arguments (although leave normal ones alone); we can't really
# know which are which, but if we're writing out an `nqp::op`
Expand Down
36 changes: 18 additions & 18 deletions src/Perl6/Metamodel/ClassHOW.nqp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -382,30 +382,30 @@ class Perl6::Metamodel::ClassHOW
}

#?if moar
nqp::dispatch('boot-syscall', 'dispatcher-register', 'raku-class-archetypes', -> $capture {
nqp::register('raku-class-archetypes', -> $capture {
# Returns archetypes of a class or a class instance
# Dispatcher arguments:
# ClassHOW object
# invocator
my $how := nqp::captureposarg($capture, 0);

my $track-how := nqp::dispatch('boot-syscall', 'dispatcher-track-arg', $capture, 0);
nqp::dispatch('boot-syscall', 'dispatcher-guard-concreteness', $track-how);
my $track-how := nqp::syscall('dispatcher-track-arg', $capture, 0);
nqp::syscall('dispatcher-guard-concreteness', $track-how);

unless nqp::isconcrete($how) {
nqp::dispatch('boot-syscall', 'dispatcher-delegate', 'boot-code-constant', $archetypes-ng);
nqp::delegate('boot-code-constant', $archetypes-ng);
}

my $obj := nqp::captureposarg($capture, 1);
my $track-obj := nqp::dispatch('boot-syscall', 'dispatcher-track-arg', $capture, 1);
nqp::dispatch('boot-syscall', 'dispatcher-guard-concreteness', $track-obj);
nqp::dispatch('boot-syscall', 'dispatcher-guard-type', $track-obj);
my $track-obj := nqp::syscall('dispatcher-track-arg', $capture, 1);
nqp::syscall('dispatcher-guard-concreteness', $track-obj);
nqp::syscall('dispatcher-guard-type', $track-obj);

if nqp::isconcrete_nd($obj) && nqp::iscont($obj) {
my $Scalar := nqp::gethllsym('Raku', 'Scalar');
my $track-value := nqp::dispatch('boot-syscall', 'dispatcher-track-attr', $track-obj, $Scalar, '$!value');
nqp::dispatch('boot-syscall', 'dispatcher-guard-concreteness', $track-value);
nqp::dispatch('boot-syscall', 'dispatcher-guard-type', $track-value);
my $track-value := nqp::syscall('dispatcher-track-attr', $track-obj, $Scalar, '$!value');
nqp::syscall('dispatcher-guard-concreteness', $track-value);
nqp::syscall('dispatcher-guard-type', $track-value);
$obj := nqp::getattr($obj, $Scalar, '$!value');
}

Expand All @@ -414,21 +414,21 @@ class Perl6::Metamodel::ClassHOW
if nqp::isconcrete($obj) && $can-is-generic {
# If invocant of .HOW.archetypes is a concrete object implementing 'is-generic' method then method outcome
# is the ultimate result. But we won't cache it in type's HOW $!archetypes.
nqp::dispatch('boot-syscall', 'dispatcher-delegate', 'boot-code-constant',
nqp::dispatch('boot-syscall', 'dispatcher-insert-arg-literal-obj',
nqp::dispatch('boot-syscall', 'dispatcher-drop-arg',
nqp::dispatch('boot-syscall', 'dispatcher-drop-arg', $capture, 1),
nqp::delegate('boot-code-constant',
nqp::syscall('dispatcher-insert-arg-literal-obj',
nqp::syscall('dispatcher-drop-arg',
nqp::syscall('dispatcher-drop-arg', $capture, 1),
0),
0, { $obj.is-generic ?? $archetypes-g !! $archetypes-ng }));
}
else {
my $track-archetypes-attr :=
nqp::dispatch('boot-syscall', 'dispatcher-track-attr',
nqp::syscall('dispatcher-track-attr',
$track-how, Perl6::Metamodel::ClassHOW, '$!archetypes');
nqp::dispatch('boot-syscall', 'dispatcher-guard-literal', $track-archetypes-attr);
nqp::syscall('dispatcher-guard-literal', $track-archetypes-attr);

nqp::dispatch('boot-syscall', 'dispatcher-delegate', 'boot-constant',
nqp::dispatch('boot-syscall', 'dispatcher-insert-arg-literal-obj', $capture, 0,
nqp::delegate('boot-constant',
nqp::syscall('dispatcher-insert-arg-literal-obj', $capture, 0,
(nqp::getattr($how, Perl6::Metamodel::ClassHOW, '$!archetypes') // $archetypes-ng)));
}
});
Expand Down

0 comments on commit becb682

Please sign in to comment.