| git.druid.rocks | index | druid520 | nscc | src/ | jtype3.pl |
src/jtype3.pl
#!/usr/bin/env perl
# jtype3 -- the nscc type stage, fourth stage of the nscc pipeline.
# owns: type checking, explicit-cast insertion (every conversion that
# happens anywhere becomes a literal (cast T ...) node in the tree --
# nothing converts invisibly in a later stage), power-arithmetic
# scaling (arithmetic is performed at the wider of its two operand
# widths; a literal operand adopts the other operand's width instead,
# so i8 + 1 stays i8 arithmetic), width rules (i8/i16/i32/i64/ptr, all
# signed, wrap-around defined), function call arity/type checking, and
# the two places a value must be a compile-time constant: case labels
# and global initializers (the only constant folding nscc ever does --
# nothing else is ever folded, nscc optimizes nothing).
#
# pointer rules, in full (ptr is one untyped 8-byte address type):
# ptr + int and int + ptr are byte arithmetic yielding ptr; ptr - ptr
# is a byte distance yielding i64; ptr - int yields ptr; *p yields i64
# (an 8-byte load -- there is no pointed-to type to size it otherwise);
# &x yields ptr, and so does &f for a function f; ptr ==/!= ptr compare
# as addresses; casts convert freely between ptr and the int types.
# p(args) on a ptr p is an indirect call: no signature to check (arg
# count and types are unchecked), result i64, like *p.
#
# output format .tast.j3: same tree shape, but every expression node
# carries trailing ': TYPE' atoms (the (ret ...) node does too, when
# it returns a value) and every conversion is an explicit (cast T E)
# node, inserted by this stage.
#
# this stage's own mini pipeline: in -- preproc -- proc -- out, where
# preproc is the ast deserialization and proc is the typing proper.
use v5.16;
use strict;
use warnings FATAL => 'all';
use FindBin;
use lib "$FindBin::Bin";
use jcplib::util qw(stage_err is_int is_signed %WIDTH %IWIDTH);
use jcplib::tree qw(read_tree write_tree mk find_kid);
my $RAW = do { local $/; <STDIN>; };
my %SYMS; # symid -> {type => .., name => .., kind => .., const => ..}
my %FSYMS; # symid -> {ret => .., params => [..], name => ..}
my %STRUCTS; # struct name -> [field types in order]
my %FIELDS; # "name.field" -> field index (word offset)
my %EVAL; # enum symid -> folded i32 value (memo)
my %EVALING; # enum symid -> 1 while its value is being computed
my $CTX; # current function's func node (for ret typing/error pos)
my $FILE = $ENV{NSCC_FILE} || 'input';
# the word count of a type, in 8-byte storage slots: one per scalar,
# one per struct field, and ceil(N*width/8) for an array (arrays are
# byte-packed). used for the struct return/param caps and slot math.
sub words_of {
my ($t) = @_;
if($t =~ /^struct\.(.+)$/) { return scalar @{$STRUCTS{$1}}; }
if($t =~ /^\[(\d+)\](.+)$/) { my $b = $1 * bytes_of($2); return ($b + 7) >> 3; }
return 1;
}
# the byte size of a type: scalars by width, structs 8 per field,
# arrays N * element size (the packed width).
sub bytes_of {
my ($t) = @_;
return $WIDTH{$t} if is_int($t) || $t eq 'ptr';
return 8 * scalar(@{$STRUCTS{$1}}) if $t =~ /^struct\.(.+)$/;
return $1 * bytes_of($2) if $t =~ /^\[(\d+)\](.+)$/;
return 0;
}
sub err_at {
my ($node, $msg) = @_;
my ($at) = grep { /^at=/ } @{$node->{atoms}};
$at //= 'at=?:?';
$at =~ s/^at=//;
stage_err("jtype3: $FILE:$at: $msg");
}
sub symid_of {
my ($node) = @_;
my ($s) = map { /^sym=(-?\d+)$/ ? $1 : () } @{$node->{atoms}};
return $s if defined $s;
# (ref N) nodes carry the bare id as their only atom.
my ($b) = grep { /^-?\d+$/ } @{$node->{atoms}};
return $b;
}
sub type_of {
my ($node) = @_;
my $atoms = $node->{atoms};
return $atoms->[-1] if @$atoms && $atoms->[-2] && $atoms->[-2] eq ':';
return undef;
}
sub annotate {
my ($node, $t) = @_;
push @{$node->{atoms}}, ':', $t;
return $node;
}
sub ensure {
my ($t, $node) = @_;
my $st = type_of($node);
stage_err('jtype3: aggregate used as a scalar') if $st =~ /^(struct\.|\[)/;
return $node if $st eq $t;
return annotate(mk('cast', [$t], [$node]), $t);
}
# ensure() for a value binding (assign, decl init, return, call arg):
# an int value where a ptr is expected is an error -- the one and only
# null pointer is the explicit cast (ptr)0, so an implicit int-to-ptr
# conversion is never allowed. aggregates never convert implicitly:
# the same struct passes (word-by-word copy semantics, handled by
# jlower5), anything else is an error.
sub ensure_target {
my ($t, $node, $ctx) = @_;
my $st = type_of($node);
if($t eq 'ptr' && is_int($st)) {
err_at($ctx, 'implicit int-to-ptr conversion: cast explicitly, e.g. (ptr)0');
}
# no implicit signed<->unsigned conversion in a binding: cast one
# side explicitly (u8 x = 10; and i8 y = (i8)x * 2; are fine, but
# i8 x; u8 y = x; is an error). a literal is exempt -- it adopts
# the target's signedness (u8 x = 200; is fine; -1 is a unop, not
# a literal, so i8 x = -1; needs the cast, write (i8)-1).
if(is_int($t) && is_int($st) && is_signed($t) != is_signed($st)
&& $node->{op} ne 'intlit' && $node->{op} ne 'charlit') {
err_at($ctx, "implicit signed/unsigned conversion: expected $t, got $st -- cast explicitly");
}
if($t =~ /^(struct\.|\[)/ || $st =~ /^(struct\.|\[)/) {
err_at($ctx, "cannot use a struct or array value here: expected $t, got $st")
unless $t eq $st;
return $node if $t eq $st;
}
return ensure($t, $node);
}
sub int_value {
my ($text) = @_;
my $v;
if($text =~ /^0[xX]([0-9A-Fa-f]+)$/) {
# a hex literal with the high bit of a 64-bit word set (16 hex
# digits starting 8-f) trips perl's own "non-portable" advisory
# under `use warnings FATAL` -- purely a heads-up that this
# wouldn't fit on an old 32-bit-int perl build, irrelevant here
# since nsc's own u64/i64 support already requires a 64-bit
# perl to begin with, and hex() computes the correct value
# regardless (verified: 0x73666d6f6f62616b -> 8315454087363715435,
# exactly right). scoped narrowly so a real portability concern
# elsewhere still fails loudly.
no warnings 'portable';
$v = hex($1);
}
else { $v = 0 + $text; }
return $v;
}
sub fits_i32 { my ($v) = @_; return $v <= 0x7FFFFFFF; }
sub fits_i64 { my ($v) = @_; return $v <= (~0 >> 1); }
# constant folding -- the ONLY place nscc folds anything. accepts a
# literal, -literal, and casts around those; returns a signed 64-bit
# value or undef if the expression isn't constant. cast folding
# truncates to the width then sign-extends, exactly like a real
# conversion.
sub fold_const {
my ($e, $ctx) = @_;
if($e->{op} eq 'intlit') { return int_value($e->{atoms}[0]); }
if($e->{op} eq 'charlit') { return int_value($e->{atoms}[0]); }
if($e->{op} eq 'ref') {
# an enumerator reference folds to its value (recursively,
# so enum { A = 1, B = A + 1 } works).
my $sym = $SYMS{symid_of($e)};
return enum_value(symid_of($e)) if $sym && ($sym->{kind} // '') eq 'enum';
return undef;
}
if($e->{op} eq 'unop' && $e->{atoms}[0] eq '-') {
my $v = fold_const($e->{kids}[0], $ctx);
return undef unless defined $v;
# exact 64-bit negation: perl's 2**64-1 masks are doubles
# (NV) and silently lose bits, so the wrap goes through
# pack/unpack, which is exact for 64-bit values.
return unpack('q', pack('Q', (-$v) & ~0));
}
if($e->{op} eq 'binop') {
# constant expressions fold here -- this feeds ONLY the
# fail-fast guards (shift range, div/mod), case labels and
# global initializers; it never replaces code with
# constants in the output.
my $a = fold_const($e->{kids}[0], $ctx);
my $b = fold_const($e->{kids}[1], $ctx);
return undef unless defined $a && defined $b;
my $op = $e->{atoms}[0];
my $u;
if($op eq '+') { $u = ($a + $b) & ~0; }
elsif($op eq '-') { $u = ($a - $b) & ~0; }
elsif($op eq '*') { $u = ($a * $b) & ~0; }
elsif($op eq '&') { $u = $a & $b; }
elsif($op eq '|') { $u = $a | $b; }
elsif($op eq '^') { $u = $a ^ $b; }
elsif($op eq '<<') { $u = ($a << $b) & ~0; }
elsif($op eq '>>') { return $a >> $b; } # perl's IV >> is arithmetic
else { return undef; }
return unpack('q', pack('Q', $u));
}
if($e->{op} eq 'cast') {
my $v = fold_const($e->{kids}[0], $ctx);
return undef unless defined $v;
my $t = $e->{atoms}[0];
return $v if $t eq 'i64' || $t eq 'ptr';
my $bits = $IWIDTH{$t};
$v &= (1 << $bits) - 1;
$v -= (1 << $bits) if $v >= (1 << ($bits - 1));
return $v;
}
return undef;
}
sub unify_arith {
my ($e, $op, $l, $r, $ctx) = @_;
my ($lt, $rt) = (type_of($l), type_of($r));
if($op eq '+' || $op eq '-') {
if($lt eq 'ptr' && $rt eq 'ptr') {
$e->{kids}[0] = ensure('i64', $l);
$e->{kids}[1] = ensure('i64', $r);
return 'i64';
}
if($lt eq 'ptr' && is_int($rt)) {
$e->{kids}[1] = ensure('i64', $r);
return 'ptr';
}
if(is_int($lt) && $rt eq 'ptr' && $op eq '+') {
$e->{kids}[0] = ensure('i64', $l);
return 'ptr';
}
}
if($lt eq 'ptr' || $rt eq 'ptr') {
err_at($ctx, "ptr may only be used with int in '+', '-', '==', '!='");
}
if(!is_int($lt) || !is_int($rt)) {
err_at($ctx, "arithmetic on non-int operands");
}
# nsc has no usual arithmetic conversions: mixed signed/unsigned
# arithmetic is an error -- cast one side explicitly. a literal
# operand adopts the other side's type instead, so u64 * 1000 is
# fine and 1000 is simply an unsigned constant.
my $lit = ($l->{op} eq 'intlit' || $l->{op} eq 'charlit') || ($r->{op} eq 'intlit' || $r->{op} eq 'charlit');
err_at($ctx, 'mixed signed/unsigned arithmetic: cast explicitly')
if !$lit && is_signed($lt) != is_signed($rt);
# literal operands adopt the other side's width (i8 + 1 is i8);
# otherwise the pair is performed at the wider width.
my $t;
if($l->{op} eq 'intlit' || $l->{op} eq 'charlit') { $t = $rt; }
elsif($r->{op} eq 'intlit' || $r->{op} eq 'charlit') { $t = $lt; }
else { $t = $WIDTH{$lt} >= $WIDTH{$rt} ? $lt : $rt; }
$e->{kids}[0] = ensure($t, $l);
$e->{kids}[1] = ensure($t, $r);
return $t;
}
sub type_expr {
my ($e, $ctx, $value_ctx) = @_;
my $op = $e->{op};
if($op eq 'intlit') {
my $v = int_value($e->{atoms}[0]);
my $t = fits_i32($v) ? 'i32' : fits_i64($v) ? 'i64' : (err_at($ctx, 'integer literal does not fit in i64'), 'i64');
return annotate($e, $t);
}
if($op eq 'charlit') { return annotate($e, 'i32'); }
if($op eq 'strlit') { return annotate($e, 'ptr'); }
if($op eq 'ref') {
my $sym = $SYMS{symid_of($e)};
if($sym->{kind} && $sym->{kind} eq 'enum') {
# an enumerator is a compile-time constant: fold it in
# place into (cast i32 (intlit V : i32) : i32), so
# every caller keeps the same node ref.
my $v = enum_value(symid_of($e));
$e->{op} = 'cast';
$e->{atoms} = ['i32'];
$e->{kids} = [annotate(mk('intlit', [$v], []), 'i32')];
return annotate($e, 'i32');
}
return annotate($e, $sym->{type});
}
if($op eq 'member') {
my ($base) = @{$e->{kids}};
type_expr($base, $ctx, 1);
my $bt = type_of($base);
my $fname = $e->{atoms}[0];
my $sk;
if($bt =~ /^struct\.(.+)$/) {
$sk = $1;
}
elsif($base->{op} eq 'deref') {
# p->x (or (*p).x) through an untyped ptr: the field name
# must be unambiguous across the whole unit -- ptr has no
# pointee type, so the name is all there is to go on.
my @hit = grep { defined $FIELDS{"$_" . "." . $fname} } keys %STRUCTS;
err_at($ctx, "field '$fname' does not exist in any struct") unless @hit;
err_at($ctx, "field '$fname' is ambiguous through a ptr: name it with a struct-typed variable")
if @hit > 1;
$sk = $hit[0];
}
else {
err_at($ctx, "'.' needs a struct operand, got $bt");
}
my $k = $FIELDS{"$sk.$fname"};
err_at($ctx, "struct '$sk' has no field '$fname'") unless defined $k;
# the field index rides the node (jlower5 needs it to
# compute the word offset; nothing downstream has the
# struct's field order).
$e->{atoms} = [$fname, "k=$k"];
return annotate($e, $STRUCTS{$sk}[$k]);
}
if($op eq 'index') {
my ($base, $idx) = @{$e->{kids}};
type_expr($base, $ctx, 1);
type_expr($idx, $ctx, 1);
my $bt = type_of($base);
err_at($ctx, "indexing needs an array operand, got $bt") unless $bt =~ /^\[(\d+)\](.+)$/;
my ($n, $et) = ($1, $2);
err_at($ctx, 'index must be int') unless is_int(type_of($idx));
# constant indexes are bounds-checked at compile time; a
# dynamic index is the programmer's business.
my $cv = fold_const($idx, $ctx);
if(defined $cv) {
err_at($ctx, "index $cv is out of bounds for [$n]$et") if $cv < 0 || $cv >= $n;
}
$e->{kids}[1] = ensure('i64', $idx);
return annotate($e, $et);
}
if($op eq 'sizeof') {
my $t;
if(@{$e->{kids}}) {
# sizeof(expr): the operand's type decides.
type_expr($e->{kids}[0], $ctx, 1);
$t = type_of($e->{kids}[0]);
}
else {
# sizeof(type).
$t = $e->{atoms}[0];
}
err_at($ctx, 'cannot take sizeof void') if $t eq 'void';
# sizeof is a compile-time constant: fold it here (in place,
# so every caller keeps the same node ref) into (cast i64
# (intlit N : i32) : i64). result type i64.
my $bytes = bytes_of($t);
$e->{op} = 'cast';
$e->{atoms} = ['i64'];
$e->{kids} = [annotate(mk('intlit', [$bytes], []), 'i32')];
return annotate($e, 'i64');
}
if($op eq 'binop') {
my ($l, $r) = @{$e->{kids}};
my $bop = $e->{atoms}[0];
type_expr($l, $ctx, 1);
type_expr($r, $ctx, 1);
my $t;
if($bop eq '&&' || $bop eq '||') {
$e->{kids}[0] = ensure('i64', $l);
$e->{kids}[1] = ensure('i64', $r);
$t = 'i32';
}
elsif($bop eq '==' || $bop eq '!=' || $bop eq '<' || $bop eq '<=' || $bop eq '>' || $bop eq '>=') {
my ($lt, $rt) = (type_of($l), type_of($r));
if(($bop eq '==' || $bop eq '!=') && $lt eq 'ptr' && $rt eq 'ptr') {
$e->{kids}[0] = ensure('i64', $l);
$e->{kids}[1] = ensure('i64', $r);
$t = 'i32';
}
else {
err_at($ctx, "ordered comparison needs two int operands") if ($lt eq 'ptr' || $rt eq 'ptr') && $bop ne '==' && $bop ne '!=';
err_at($ctx, "comparison of incompatible operands") unless is_int($lt) && is_int($rt);
my $lit = ($l->{op} eq 'intlit' || $l->{op} eq 'charlit') || ($r->{op} eq 'intlit' || $r->{op} eq 'charlit');
err_at($ctx, 'mixed signed/unsigned comparison: cast explicitly') if !$lit && is_signed($lt) != is_signed($rt);
my $w;
if($lit) { $w = ($l->{op} eq 'intlit' || $l->{op} eq 'charlit') ? $rt : $lt; }
else { $w = $WIDTH{$lt} >= $WIDTH{$rt} ? $lt : $rt; }
$e->{kids}[0] = ensure($w, $l);
$e->{kids}[1] = ensure($w, $r);
$t = 'i32';
}
}
elsif($bop eq '<<' || $bop eq '>>') {
my $lt = type_of($l);
err_at($ctx, 'shift needs an int left operand') unless is_int($lt);
err_at($ctx, 'shift count must be int') unless is_int(type_of($r));
# a constant shift count outside [0, width) is an error
# (fail fast); a non-constant count is the programmer's
# business (the hardware masks it, nsc does not define
# that).
my $cnt = fold_const($r, $ctx);
if(defined $cnt) {
my $w = $IWIDTH{$lt};
err_at($ctx, "shift count $cnt is out of range for $lt") if $cnt < 0 || $cnt >= $w;
}
$e->{kids}[1] = ensure('i64', $r);
$t = $lt;
}
else {
$t = unify_arith($e, $bop, $l, $r, $ctx);
if($bop eq '/' || $bop eq '%') {
# constant division by zero (and INT_MIN / -1,
# which traps in the hardware) is a compile error;
# the non-constant cases trap at runtime.
my $rv = fold_const($e->{kids}[1], $ctx);
if(defined $rv) {
err_at($ctx, 'division by zero') if $rv == 0;
# INT_MIN / -1 traps in the hardware -- for
# SIGNED types only (unsigned has no INT_MIN).
my $lv = fold_const($e->{kids}[0], $ctx);
if(defined $lv && $rv == -1 && is_signed($t)) {
my $w = $IWIDTH{$t};
my $min = -(2**($w - 1));
err_at($ctx, "INT_MIN / -1 traps for $t") if $lv == $min;
}
}
}
}
return annotate($e, $t);
}
if($op eq 'unop') {
my ($u) = @{$e->{kids}};
type_expr($u, $ctx, 1);
my $uop = $e->{atoms}[0];
if($uop eq '!') {
$e->{kids}[0] = ensure('i64', $u);
return annotate($e, 'i32');
}
err_at($ctx, "unary $uop needs an int operand") unless is_int(type_of($u));
return annotate($e, type_of($u));
}
if($op eq 'addr') {
my ($u) = @{$e->{kids}};
# &function: jscope2 left a (ref ID) naming the function's
# sym. a function designator is not a value, so it carries no
# ': T' of its own; the address it yields is a plain ptr --
# there is no function-pointer type, ptr is the one pointer.
if($u->{op} eq 'ref' && $FSYMS{symid_of($u)}) {
return annotate($e, 'ptr');
}
type_expr($u, $ctx, 1);
err_at($ctx, "& needs an assignable expression") unless $u->{op} eq 'ref' || $u->{op} eq 'deref' || $u->{op} eq 'member' || $u->{op} eq 'index';
return annotate($e, 'ptr');
}
if($op eq 'deref') {
my ($u) = @{$e->{kids}};
type_expr($u, $ctx, 1);
err_at($ctx, '* needs a ptr operand') unless type_of($u) eq 'ptr';
return annotate($e, 'i64');
}
if($op eq 'cast') {
my $t = $e->{atoms}[0];
my ($u) = @{$e->{kids}};
type_expr($u, $ctx, 1);
my $ut = type_of($u);
err_at($ctx, "cannot cast to void") if $t eq 'void';
err_at($ctx, 'cannot cast to or from a struct') if $t =~ /^struct\./ || $ut =~ /^struct\./;
err_at($ctx, 'cannot cast to or from an array: use &a[0]') if $t =~ /^\[/ || $ut =~ /^\[/;
err_at($ctx, "cannot cast from void") unless is_int($ut) || $ut eq 'ptr';
err_at($ctx, "cannot cast to $t") unless is_int($t) || $t eq 'ptr';
# a literal too big for i32 is typed i64 by the literal rule;
# casting one down to a narrower int is a silent-wrap bug in
# the making, so it is an error (small i32 literals may cast
# down freely -- (i8)200 is deliberate). u64 is exempted
# alongside i64 itself: a literal is always non-negative by
# construction (negation is a separate unary op, never part of
# the literal token), so an i64-typed literal is always within
# [0, i64::MAX], and i64/u64 are the same width -- (u64) of one
# is a same-width reinterpretation, never a truncation, no
# matter how large the literal is. found this while giving kfs
# an 8-byte magic number (0x73666d6f6f62616b) that legitimately
# needs its high bit region set: (u64) of it was being rejected
# as if it were narrowing, which it structurally cannot be.
if(($u->{op} eq 'intlit' || $u->{op} eq 'charlit') && type_of($u) eq 'i64' && is_int($t) && $t ne 'i64' && $t ne 'u64') {
err_at($ctx, "i64 literal does not fit in $t: the cast would wrap silently");
}
return annotate($e, $t);
}
if($op eq 'cond') {
my ($c, $then, $else) = @{$e->{kids}};
type_expr($c, $ctx, 1);
type_expr($then, $ctx, 1);
type_expr($else, $ctx, 1);
$e->{kids}[0] = ensure('i64', $c);
my ($tt, $et) = (type_of($then), type_of($else));
err_at($ctx, '?: arms must both be values of the same kind') unless is_int($tt) || is_int($et);
err_at($ctx, '?: cannot mix a ptr arm with an int arm: cast explicitly') if ($tt eq 'ptr') != ($et eq 'ptr');
my $t;
if($then->{op} eq 'intlit' || $then->{op} eq 'charlit') { $t = $et; }
elsif($else->{op} eq 'intlit' || $else->{op} eq 'charlit') { $t = $tt; }
else { $t = $WIDTH{$tt} >= $WIDTH{$et} ? $tt : $et; }
$e->{kids}[1] = ensure($t, $then);
$e->{kids}[2] = ensure($t, $else);
return annotate($e, $t);
}
if($op eq 'call') {
my $id = $e->{atoms}[0];
my $fs = $FSYMS{$id};
err_at($ctx, "call to unknown function sym=$id") unless $fs;
err_at($ctx, "call to '$fs->{name}' with " . scalar(@{$e->{kids}}) . " args, expected " . scalar(@{$fs->{params}}))
unless @{$e->{kids}} == @{$fs->{params}};
err_at($ctx, "call to '$fs->{name}' has more than 6 args (nsc limit)")
if @{$e->{kids}} > 6;
for my $i (0 .. $#{$e->{kids}}) {
type_expr($e->{kids}[$i], $ctx, 1);
$e->{kids}[$i] = ensure_target($fs->{params}[$i], $e->{kids}[$i], $ctx);
}
err_at($ctx, "call to void function '$fs->{name}' used as a value") if $fs->{ret} eq 'void' && $value_ctx;
# a struct/array-returning call has no standalone value: it
# must be assigned directly to a same-type lvalue or be a
# decl's initializer (jlower5 writes it straight into the
# target's slots). $value_ctx == 2 marks that one place.
if($fs->{ret} =~ /^(struct\.|\[)/ && $value_ctx == 1) {
err_at($ctx, "struct/array-returning call must be assigned directly to a same-type lvalue");
}
if($fs->{ret} =~ /^(struct\.|\[)/ && $value_ctx == 0) {
err_at($ctx, "discarding a struct/array-returning call is not allowed");
}
return annotate($e, $fs->{ret});
}
if($op eq 'icall') {
# an indirect call through a ptr value. ptr is untyped, so
# there is no signature to check against: arg count and arg
# types are the programmer's business (same as what *p points
# at), each arg passes at its own type, and the result is an
# i64 -- whatever the callee left in %rax, exactly like *p's
# 8-byte load (cast it down to taste; a void callee's result
# is garbage). only the sysv register cap and scalar-only args
# are enforced, since those are the call's own mechanics.
my ($callee, @args) = @{$e->{kids}};
type_expr($callee, $ctx, 1);
my $ct = type_of($callee);
err_at($ctx, "call through a non-ptr expression (got $ct): a function's address is a ptr, take it with &name")
unless $ct eq 'ptr';
err_at($ctx, "indirect call has more than 6 args (nsc limit)")
if @args > 6;
for my $a (@args) {
type_expr($a, $ctx, 1);
my $at = type_of($a);
err_at($ctx, "an indirect call's args must be scalars (int or ptr), got $at")
unless is_int($at) || $at eq 'ptr';
}
return annotate($e, 'i64');
}
if($op eq 'assign') {
my ($lhs, $rhs) = @{$e->{kids}};
my $aop = $e->{atoms}[0];
type_expr($lhs, $ctx, 1);
type_expr($rhs, $ctx, $aop eq '=' && $rhs->{op} eq 'call' ? 2 : 1);
err_at($ctx, 'left side of assignment is not assignable')
unless $lhs->{op} eq 'ref' || $lhs->{op} eq 'deref' || $lhs->{op} eq 'member' || $lhs->{op} eq 'index';
err_at($ctx, 'assignment to a const') if $lhs->{op} eq 'ref' && $SYMS{symid_of($lhs)}{const};
my $lt = type_of($lhs);
if($aop eq '=') {
# structs assign to the SAME struct, word by word; arrays
# do not assign at all (no whole-array copies -- explicit).
if($lt =~ /^struct\./ || type_of($rhs) =~ /^struct\./) {
err_at($ctx, 'struct assignment needs both sides to be the same struct')
unless $lt eq type_of($rhs) && $lt =~ /^struct\./;
}
# a struct-returning call can only land in a local's
# slots (jlower5 writes it straight there).
if($lt =~ /^struct\./ && $rhs->{op} eq 'call' && $lhs->{op} eq 'ref' && ($SYMS{symid_of($lhs)}{kind} // '') eq 'gvar') {
err_at($ctx, 'a struct-returning call can only be assigned to a local');
}
$e->{kids}[1] = ensure_target($lt, $rhs, $ctx);
}
else {
my $top = $aop =~ /<<|>>/ ? $aop : substr($aop, 0, 1);
if($lt eq 'ptr') {
err_at($ctx, 'compound assign on ptr only supports += and -=') unless $top eq '+' || $top eq '-';
$e->{kids}[1] = ensure('i64', $rhs);
}
else {
err_at($ctx, 'compound assign needs int operands') unless is_int($lt) && is_int(type_of($rhs));
if(is_signed($lt) != is_signed(type_of($rhs))
&& $rhs->{op} ne 'intlit' && $rhs->{op} ne 'charlit') {
err_at($ctx, 'mixed signed/unsigned compound assign: cast explicitly');
}
my $t;
if($rhs->{op} eq 'intlit' || $rhs->{op} eq 'charlit') { $t = $lt; }
else { $t = $WIDTH{$lt} >= $WIDTH{type_of($rhs)} ? $lt : type_of($rhs); }
$e->{kids}[1] = ensure($t, $rhs);
$e->{kids}[1] = ensure($lt, $e->{kids}[1]);
}
}
return annotate($e, $lt);
}
if($op eq 'preinc' || $op eq 'postinc' || $op eq 'predec' || $op eq 'postdec') {
my ($lhs) = @{$e->{kids}};
type_expr($lhs, $ctx, 1);
err_at($ctx, '++/-- need an assignable int')
unless ($lhs->{op} eq 'ref' || $lhs->{op} eq 'deref' || $lhs->{op} eq 'member' || $lhs->{op} eq 'index') && is_int(type_of($lhs));
err_at($ctx, '++/-- on a const') if $lhs->{op} eq 'ref' && $SYMS{symid_of($lhs)}{const};
return annotate($e, type_of($lhs));
}
stage_err("jtype3: unknown expression node: $op");
}
sub type_stmt {
my ($s, $ret_t) = @_;
my $op = $s->{op};
if($op eq 'block') {
type_stmt($_, $ret_t) for @{$s->{kids}};
return;
}
if($op eq 'decl') {
my $ty = $s->{atoms}[1];
err_at($s, 'a variable cannot have type void') if $ty eq 'void';
# arrays hold scalars only (no arrays of structs).
if($ty =~ /^\[(\d+)\](.+)$/ && !is_int($2) && $2 ne 'ptr') {
err_at($s, "array elements must be scalar (i8..u64 or ptr), got $2");
}
my $init = find_kid($s, 'init');
if($init) {
my $e0 = $init->{kids}[0];
if($e0->{op} eq 'initlist') {
type_initlist($e0, $ty, $s);
}
else {
type_expr($e0, $s, $e0->{op} eq 'call' ? 2 : 1);
$init->{kids}[0] = ensure_target($ty, $e0, $s);
}
}
return;
}
# a struct/array initializer list: the element count must match the
# struct's field count or the array's length exactly, and every element
# converts to its field/element type.
sub type_initlist {
my ($lst, $ty, $ctx) = @_;
my @els = @{$lst->{kids}};
my @expect;
if($ty =~ /^struct\.(.+)$/) { @expect = @{$STRUCTS{$1}}; }
elsif($ty =~ /^\[(\d+)\](.+)$/) { @expect = ($2) x $1; }
else { err_at($ctx, 'an initializer list needs a struct or array'); }
err_at($ctx, "initializer list has " . scalar(@els) . " elements, expected " . scalar(@expect))
unless @els == @expect;
for my $i (0 .. $#els) {
type_expr($els[$i], $ctx, 1);
$els[$i] = ensure_target($expect[$i], $els[$i], $ctx);
}
# write the (possibly cast) elements back -- @els is a copy.
$lst->{kids} = \@els;
return;
}
if($op eq 'stmt') {
type_expr($s->{kids}[0], $s, 0);
my $eop = $s->{kids}[0]{op};
err_at($s, "expression statement must be an assignment, call, or ++/--, got '$eop'")
unless $eop eq 'assign' || $eop eq 'call' || $eop eq 'icall' || $eop eq 'preinc' || $eop eq 'postinc' || $eop eq 'predec' || $eop eq 'postdec';
return;
}
if($op eq 'assign') {
type_expr($s, $s, 0);
return;
}
if($op eq 'ret') {
if(@{$s->{kids}}) {
err_at($s, "'return' with a value in a void function") if $ret_t eq 'void';
type_expr($s->{kids}[0], $s, 1);
if($ret_t =~ /^struct\./) {
# a struct return is a word copy out of the
# variable's own slots: only a plain variable of the
# same type qualifies (no members, no calls).
err_at($s, 'returning a struct needs a plain variable of the same type')
unless $s->{kids}[0]{op} eq 'ref' && type_of($s->{kids}[0]) eq $ret_t;
annotate($s, $ret_t);
return;
}
$s->{kids}[0] = ensure_target($ret_t, $s->{kids}[0], $s);
annotate($s, $ret_t);
}
else {
err_at($s, "bare 'return' in a non-void function (return $ret_t expected)") unless $ret_t eq 'void';
}
return;
}
if($op eq 'if') {
type_expr($s->{kids}[0], $s, 1);
$s->{kids}[0] = ensure('i64', $s->{kids}[0]);
type_stmt($s->{kids}[1], $ret_t);
if(@{$s->{kids}} > 2) { type_stmt($s->{kids}[2]{kids}[0], $ret_t); }
return;
}
if($op eq 'while') {
type_expr($s->{kids}[0], $s, 1);
$s->{kids}[0] = ensure('i64', $s->{kids}[0]);
type_stmt($s->{kids}[1], $ret_t);
return;
}
if($op eq 'switch') {
type_expr($s->{kids}[0], $s, 1);
$s->{kids}[0] = ensure('i64', $s->{kids}[0]);
my %seen;
for my $k (@{$s->{kids}}[1 .. $#{$s->{kids}}]) {
if($k->{op} eq 'case') {
my $v = fold_const($k->{kids}[0], $s);
err_at($s, 'case value must be a constant') unless defined $v;
err_at($s, "duplicate case value $v") if $seen{$v}++;
$k->{kids}[0] = annotate(mk('cast', ['i64'], [annotate(mk('intlit', [$v], []), 'i32')]), 'i64');
type_stmt($_, $ret_t) for @{$k->{kids}}[1 .. $#{$k->{kids}}];
}
else {
type_stmt($_, $ret_t) for @{$k->{kids}};
}
}
return;
}
if($op eq 'break' || $op eq 'continue') {
return;
}
stage_err("jtype3: unknown statement node: $op");
}
sub build_symtab {
my ($unit) = @_;
for my $top (@{$unit->{kids}}) {
if($top->{op} eq 'func' || $top->{op} eq 'fdecl') {
my ($ret) = map { /^ret=(.+)$/ ? $1 : () } @{$top->{atoms}};
my ($id) = map { /^sym=(\d+)$/ ? $1 : () } @{$top->{atoms}};
my $params = find_kid($top, 'params');
$FSYMS{$id} = {ret => $ret, params => [map { $_->{atoms}[1] } @{$params->{kids}}], name => $top->{atoms}[0]};
for my $p (@{$params->{kids}}) {
# params of a body-less fdecl carry no sym id (j2
# only declares params of defined functions) --
# they matter only to j2's signature check.
my $id = symid_of($p);
$SYMS{$id} = {type => $p->{atoms}[1], name => $p->{atoms}[0], kind => 'local', const => scalar grep { /^const=/ } @{$p->{atoms}}}
if defined $id;
}
next;
}
if($top->{op} eq 'gvar') {
$SYMS{symid_of($top)} = {type => $top->{atoms}[1], name => $top->{atoms}[0], kind => 'gvar', const => scalar grep { /^const=/ } @{$top->{atoms}}};
next;
}
if($top->{op} eq 'struct') {
my $name = $top->{atoms}[0];
$STRUCTS{$name} = [map { $_->{atoms}[1] } @{$top->{kids}}];
# struct fields are scalars: no nested structs, no arrays.
for my $t (@{$STRUCTS{$name}}) {
err_at($top, "struct fields must be scalar (i8..u64 or ptr), got $t")
unless is_int($t) || $t eq 'ptr';
}
for my $i (0 .. $#{$top->{kids}}) {
$FIELDS{"$name." . $top->{kids}[$i]{atoms}[0]} = $i;
}
next;
}
if($top->{op} eq 'enum') {
# enumerators were registered as syms by jscope2 (the
# enumval nodes carry sym=); their values fold lazily on
# first use, with a cycle guard in enum_value().
for my $v (@{$top->{kids}}) {
my $id = symid_of($v);
$SYMS{$id} = {kind => 'enum', name => $v->{atoms}[0],
value => $v->{kids}[0], valuectx => $v};
}
next;
}
stage_err("jtype3: unknown toplevel node: $top->{op}");
}
# locals: walk every function body's decl nodes.
for my $top (@{$unit->{kids}}) {
next unless $top->{op} eq 'func';
my $body = find_kid($top, 'body');
my $walk;
$walk = sub {
my ($n) = @_;
return unless ref $n;
if($n->{op} eq 'decl') { $SYMS{symid_of($n)} = {type => $n->{atoms}[1], name => $n->{atoms}[0], kind => 'local', const => scalar grep { /^const=/ } @{$n->{atoms}}}; }
$walk->($_) for @{$n->{kids}};
};
$walk->($body);
}
return;
}
# the folded i32 value of an enumerator (memoized; a cycle like
# enum { A = B, B = A } is an error).
sub enum_value {
my ($id) = @_;
return $EVAL{$id} if exists $EVAL{$id};
stage_err('jtype3: enumerator value cycle') if $EVALING{$id};
$EVALING{$id} = 1;
my $sym = $SYMS{$id};
my $v = $sym->{value} ? fold_const($sym->{value}, $sym->{valuectx}) : 0;
stage_err("jtype3: enumerator '$sym->{name}' is not a compile-time constant") unless defined $v;
$EVAL{$id} = $v;
delete $EVALING{$id};
return $v;
}
sub preproc {
my ($text) = @_;
return read_tree($text);
}
# a non-void function must END in a return: the last statement of the
# body (unwrapping trailing blocks) has to be a ret with a value. a
# side branch that falls off is the programmer's bug -- the epilogue
# still returns whatever %rax held -- but the end-of-function rule
# itself is strict.
sub ends_in_ret {
my ($s) = @_;
return 1 if $s->{op} eq 'ret' && @{$s->{kids}};
if($s->{op} eq 'block' && @{$s->{kids}}) {
return ends_in_ret($s->{kids}[-1]);
}
return 0;
}
sub proc {
my ($unit) = @_;
build_symtab($unit);
for my $top (@{$unit->{kids}}) {
if($top->{op} eq 'func') {
my ($ret) = map { /^ret=(.+)$/ ? $1 : () } @{$top->{atoms}};
$CTX = $top;
my $body = find_kid($top, 'body');
type_stmt($_, $ret) for @{$body->{kids}};
if($top->{atoms}[0] eq 'main') {
# main: global i32, taking () or (i32, ptr).
my $params = find_kid($top, 'params');
my $sig = join(',', map { $_->{atoms}[1] } @{$params->{kids}});
my ($linkage) = map { /^linkage=(.+)$/ ? $1 : () } @{$top->{atoms}};
err_at($top, 'main must be global') unless $linkage eq 'global';
err_at($top, 'main must return i32') unless $ret eq 'i32';
err_at($top, 'main must be i32 main(void) or i32 main(i32 argc, ptr argv)')
unless $sig eq '' || $sig eq 'i32,ptr';
}
if($ret ne 'void') {
my @stmts = @{$body->{kids}};
my $last = $stmts[-1];
err_at($last // $top, "non-void function must end in a return")
unless $last && ends_in_ret($last);
}
if($ret =~ /^struct\./) {
my $w = words_of($ret);
err_at($top, "struct $ret is too big to return by value (max 2 words): pass a ptr out-param")
if $w > 2;
}
# sysv has six arg registers, and jalloc7 knows only
# those six: a function taking more than six WORDs of
# params (a struct param counts its fields) cannot be
# called.
my $params = find_kid($top, 'params');
my $pw = 0;
$pw += words_of($_->{atoms}[1]) for @{$params->{kids}};
err_at($top, "params exceed 6 words (nsc limit)")
if $pw > 6;
}
elsif($top->{op} eq 'gvar') {
if($top->{atoms}[1] =~ /^\[(\d+)\](.+)$/ && !is_int($2) && $2 ne 'ptr') {
err_at($top, "array elements must be scalar (i8..u64 or ptr), got $2");
}
my $init = find_kid($top, 'init');
if($init) {
my $e0 = $init->{kids}[0];
if($e0->{op} eq 'initlist') {
type_initlist($e0, $top->{atoms}[1], $top);
# every element of a global initializer must
# itself be a compile-time constant.
for my $i (0 .. $#{$e0->{kids}}) {
my $v = fold_const($e0->{kids}[$i], $top);
err_at($top, 'global initializer must be a compile-time constant') unless defined $v;
my $et = type_of($e0->{kids}[$i]);
$e0->{kids}[$i] = annotate(mk('cast', [$et], [annotate(mk('intlit', [$v], []), 'i32')]), $et);
}
}
else {
my $v = fold_const($e0, $top);
err_at($top, 'global initializer must be a constant integer') unless defined $v;
$init->{kids}[0] = annotate(mk('cast', [$top->{atoms}[1]], [annotate(mk('intlit', [$v], []), 'i32')]), $top->{atoms}[1]);
}
}
}
}
return write_tree($unit);
}
print proc(preproc($RAW));