src/jselect6.pl

#!/usr/bin/env perl
# jselect6 -- the nscc instruction-selection stage, seventh stage of
# the nscc pipeline. owns: picking real x86_64 mnemonics for every lir
# op, applying the sysv amd64 calling convention (integer args in
# rdi rsi rdx rcx r8 r9 left to right, result in rax -- nsc allows at
# most 6 args so no stack args ever exist), choosing the addressing
# modes (locals are %rbp-relative slots, globals %rip-relative names,
# strings .LCn labels in .rodata), lowering conditional branches
# (if -> cmp 0 + jne, cmp -> cmp + setcc), and handing everything else
# over to vregs.
#
# output format .mir0.j6: virtual registers (%rN, one per lir %tN) and
# real mnemonics, one op per line:
#
#   func NAME sym=N linkage=LOCAL|GLOBAL ret=T frame=F locals=K vregs=V
#        %rN = mov_imm T VAL            %rN = mov T OFF(%rbp)|NAME(%rip)
#        st T SRC, OFF(%rbp)|NAME(%rip) %rN = ld8 %rM      st8 SRC, %rM
#        add|sub|imul|and|or|xor T SRC, %rN   shl|sar T SRC, %rN
#        neg|not T %rN                  %rN = cast T1 T2 %rM
#        %rN = idiv T %rA, %rB          %rN = imod T %rA, %rB
#        cmp T OP A, B   (immediately followed by)   setcc CC %rN
#        jcc CC L  |  jmp L  |  label L
#        %rN = lea_slot OFF   %rN = lea_glob NAME   %rN = lea_str .LCn
#        arg T SRC ...  call NAME | icall %rF  retv %rN
#        ret T SRC  |  ret
#        str "..." (rodata content, passthrough)
#   end
#   gvar NAME sym=N linkage=LOCAL|GLOBAL T VAL
#
# a cmp is ALWAYS immediately followed by the setcc/jcc that consumes
# it -- flags live for exactly one line, which is all the dumb slot
# allocator in jalloc7 can be trusted with. vregs= and frame= are
# recomputed here: every vreg will get its own 8-byte slot in jalloc7,
# so frame = align16(8 * (locals + vregs)).
#
# this stage's own mini pipeline: in -- preproc -- proc -- out, where
# preproc is the lir deserialization and proc is the selection.
use v5.16;
use strict;
use warnings FATAL => 'all';
use FindBin;
use lib "$FindBin::Bin";
use jcplib::util qw(stage_err);
 
my $RAW = do { local $/; <STDIN>; };
 
my %CC = (eq => 'e', ne => 'ne', lt => 'l', le => 'le', gt => 'g', ge => 'ge');
# the unsigned condition codes (jtype3 never lets a cmp mix signed
# and unsigned operands, so the operand type picks the whole table).
my %UCC = (eq => 'e', ne => 'ne', lt => 'b', le => 'be', gt => 'a', ge => 'ae');
 
sub is_unsigned {
	my ($t) = @_;
	return $t =~ /^u/;
}
 
sub lerr {
	my ($line, $msg) = @_;
	stage_err("jselect6: $msg in lir line: $line");
}
 
sub align16 {
	my ($n) = @_;
	return ($n + 15) & ~15;
}
 
my $TARGET;     # the optional target header line, passed through verbatim
 
sub preproc {
	my ($t) = @_;
	my @l = grep { /\S/ } split /\n/, $t;
	if(@l && $l[0] =~ /^target \S+( \S+=\S+)*$/) {
		$TARGET = shift @l;
	}
	return \@l;
}
 
# strip leading 5-space indent, if any
sub clean {
	my ($ln) = @_;
	$ln =~ s/^     //;
	return $ln;
}
 
sub proc {
	my ($lines) = @_;
	my $out = defined $TARGET ? "$TARGET\n" : '';
	my $strn = 0;
	my $i = 0;
	while($i < @$lines) {
		my $ln = clean($lines->[$i]);
		if($ln =~ /^gvar /) {
			$out .= "$ln\n";
			$i++;
			next;
		}
		lerr($ln, 'expected func or gvar') unless $ln =~ /^func /;
		my ($name, $sym, $linkage, $ret, $frame, $locals) =
			($ln =~ /^func (\S+) sym=(\d+) linkage=(\S+) ret=(\S+) frame=(\d+) locals=(\d+)$/)
			or lerr($ln, 'bad func header');
		$i++;
		my (%slots, @mir);
		my $maxr = 0;
		while($i < @$lines) {
			my $l = clean($lines->[$i]);
			last if $l eq 'end';
			$i++;
			if($l =~ /^(\S+) = slot \S+ (-?\d+)\(%rbp\)$/) {
				$slots{$1} = $2;
				next;
			}
			if($l =~ /^param (\S+) (%v\d+)$/) {
				push @mir, "argp $1 $slots{$2}(%rbp)";
				next;
			}
			my ($dst, $rest);
			if($l =~ /^(\S+) = (.*)$/) { ($dst, $rest) = ($1, $2); }
			my $r = sub { my $x = shift; return $x =~ /^%t(\d+)$/ ? '%r' . $1 : $x; };
			$maxr = $1 + 1 if $dst && $dst =~ /^%t(\d+)$/ && $1 + 1 > $maxr;
 
			if(!defined $dst) {
				# instruction with no destination tmp
				if($l =~ /^st (\S+) (\S+), (\S+(?: \S+)?)$/) {
					my ($t, $src, $d) = ($1, $2, $3);
					if($d =~ /^sym=\d+ name=(\S+)$/) { push @mir, "st $t " . $r->($src) . ", $1(%rip)"; }
					elsif($d =~ /^%v\d+$/) { push @mir, "st $t " . $r->($src) . ", $slots{$d}(%rbp)"; }
					elsif($d =~ /^%t\d+$/) { push @mir, "st $t " . $r->($src) . ", " . $r->($d); }
					else { lerr($l, 'bad st destination'); }
					next;
				}
				if($l =~ /^st8 (\S+), (\S+)$/) { push @mir, "st8 " . $r->($1) . ", " . $r->($2); next; }
				if($l =~ /^call (\S+) sym=(\d+) name=(\S+)(.*)$/) {
					my ($t, $name, $args) = ($1, $3, $4);
					while($args =~ /\G \((\S+) (%t\d+)\)/gc) { push @mir, "arg $1 " . $r->($2); }
					push @mir, "call $name";
					next;
				}
				if($l =~ /^icall (\S+) (%t\d+)(.*)$/) {
					# indirect call, result discarded: args in order,
					# then the call through the target's vreg.
					my ($t, $f, $args) = ($1, $2, $3);
					while($args =~ /\G \((\S+) (%t\d+)\)/gc) { push @mir, "arg $1 " . $r->($2); }
					push @mir, "icall " . $r->($f);
					next;
				}
				if($l eq 'ret void') { push @mir, 'ret'; next; }
				if($l =~ /^ret (\S+) (\S+)$/) { push @mir, "ret $1 " . $r->($2); next; }
				if($l =~ /^sret (\d+) (%v\d+)$/) { push @mir, "sret $1 $slots{$2}"; next; }
				if($l =~ /^scall (\d+) (\S+) (%v\d+)(.*)$/) {
					my ($n, $name, $dst, $args) = ($1, $2, $3, $4);
					while($args =~ /\G \((\S+) (%t\d+)\)/gc) { push @mir, "arg $1 " . $r->($2); }
					push @mir, "call $name";
					push @mir, "scall $n $slots{$dst}";
					next;
				}
				if($l =~ /^if (%t\d+) (\S+)$/) { push @mir, "cmp i64 ne " . $r->($1) . ", 0", "jcc e $2"; next; }
				if($l =~ /^goto (\S+)$/) { push @mir, "goto $1"; next; }
				if($l =~ /^label (\S+)$/) { push @mir, "label $1"; next; }
				if($l =~ /^str (.*)$/) {
					push @mir, "str $1";
					next;
				}
				lerr($l, 'unhandled instruction');
			}
 
			my $rd = $r->($dst);
 
			if($rest =~ /^const (\S+) (\S+)$/) { push @mir, "$rd = mov_imm $1 $2"; next; }
			if($rest =~ /^str "(.*)"$/) {
				# definition form: a new blob, numbered in first-use
				# order (escaped content can never hold a raw '"').
				push @mir, "str \"$1\"";
				push @mir, "$rd = lea_str .LC" . $strn++;
				next;
			}
			if($rest =~ /^str (\.LC\d+)$/) {
				# reference form: the blob already exists (identical
				# literals share one).
				push @mir, "$rd = lea_str $1";
				next;
			}
			if($rest =~ /^load (\S+) (\S+(?: \S+)?)$/) {
				my ($t, $src) = ($1, $2);
				if($src =~ /^sym=\d+ name=(\S+)$/) { push @mir, "$rd = mov $t $1(%rip)"; }
				elsif($src =~ /^%v\d+$/) { push @mir, "$rd = mov $t $slots{$src}(%rbp)"; }
				else { lerr($l, 'bad load source'); }
				next;
			}
			if($rest =~ /^ld8 (%t\d+)$/) { push @mir, "$rd = ld8 " . $r->($1); next; }
			if($rest =~ /^ld (\S+) (%t\d+)$/) { push @mir, "$rd = ld $1 " . $r->($2); next; }
			if($rest =~ /^(add|sub|mul|sdiv|smod|udiv|umod|and|or|xor|shl|sar|shr) (\S+) (%t\d+), (%t\d+)$/) {
				my $op = $1 eq 'sdiv' ? 'idiv' : $1 eq 'smod' ? 'imod' : $1 eq 'mul' ? 'imul' : $1;
				push @mir, "$rd = $op $2 " . $r->($3) . ", " . $r->($4);
				next;
			}
			if($rest =~ /^(neg|not) (\S+) (%t\d+)$/) { push @mir, "$1 $2 " . $r->($3) . ", " . $r->($dst); next; }
			if($rest =~ /^cast (\S+) (\S+) (%t\d+)$/) { push @mir, "$rd = cast $1 $2 " . $r->($3); next; }
			if($rest =~ /^cmp (\S+) (\S+) (%t\d+), (%t\d+)$/) {
				my ($t, $op, $a, $b) = ($1, $2, $3, $4);
				# the operand type picks the signed/unsigned table
				# (jtype3 never mixes them in one comparison).
				my $cc = is_unsigned($t) ? $UCC{$op} : $CC{$op};
				push @mir, "cmp $t $op " . $r->($a) . ", " . $r->($b);
				push @mir, "setcc $cc " . $r->($dst);
				next;
			}
			if($rest =~ /^addrof (\S+(?: \S+)?)$/) {
				my $op = $1;
				if($op =~ /^sym=\d+ name=(\S+)$/) { push @mir, "$rd = lea_glob $1"; }
				elsif($op =~ /^%v\d+$/) { push @mir, "$rd = lea_slot $slots{$op}"; }
				else { lerr($l, 'bad addrof operand'); }
				next;
			}
			if($rest =~ /^call (\S+) sym=(\d+) name=(\S+)(.*)$/) {
				my ($t, $name, $args) = ($1, $3, $4);
				while($args =~ /\G \((\S+) (%t\d+)\)/gc) { push @mir, "arg $1 " . $r->($2); }
				push @mir, "call $name";
				push @mir, "retv $t " . $r->($dst);
				next;
			}
			if($rest =~ /^icall (\S+) (%t\d+)(.*)$/) {
				# indirect call: same arg/retv framing as call, the
				# target is a vreg instead of a name (jalloc7 picks
				# the register; x86 calls through it natively).
				my ($t, $f, $args) = ($1, $2, $3);
				while($args =~ /\G \((\S+) (%t\d+)\)/gc) { push @mir, "arg $1 " . $r->($2); }
				push @mir, "icall " . $r->($f);
				push @mir, "retv $t " . $r->($dst);
				next;
			}
			lerr($l, 'unhandled instruction');
		}
		$i++;  # end
		my $vregs = $maxr;
		my $nf = align16(8 * ($locals + $vregs));
		$out .= "func $name sym=$sym linkage=$linkage ret=$ret frame=$nf locals=$locals vregs=$vregs\n";
		$out .= join("\n", map { "     $_" } @mir) . (@mir ? "\n" : '');
		$out .= "end\n";
	}
	return $out;
}
 
print proc(preproc($RAW));