## nextcode-form.pkg
# Compiled by:
# src/lib/compiler/core.sublib### "He who walks with truth makes life."
###
### -- Sumerian saying
stipulate
package cty = ctypes; # ctypes is from src/lib/compiler/back/low/ccalls/ctypes.pkg package hbt = highcode_basetypes; # highcode_basetypes is from src/lib/compiler/back/top/highcode/highcode-basetypes.pkg package tmp = highcode_codetemp; # highcode_codetemp is from src/lib/compiler/back/top/highcode/highcode-codetemp.pkg fun bug s
=
error_message::impossible ("nextcode:" + s);
herein
package nextcode_form { # Not sure why we don't seal here with src/lib/compiler/back/top/nextcode/nextcode-form.api #
package rk {
Record_Kind # See comments in src/lib/compiler/back/top/nextcode/nextcode-form.api = VECTOR
| RECORD
| SPILL
#
| PUBLIC_FN
| PRIVATE_FN
| FATE_FN
| FLOAT64_FATE_FN
#
| FLOAT64_BLOCK
| INT1_BLOCK
;
};
Record_Kind = rk::Record_Kind;
Pkind = VPT | RPT Int | FPT Int;
package typ {
Type
= INT # 31-bit int?
| INT1 # 32-bit int?
| FLOAT64 # Float?
| POINTER Pkind # Pointer?
| FUN # Unsigned int?
| FATE # Fate?
| DSP #
; # Empirically, ncftype_for_fun is either FATE, FUN or (POINTER VPT) in convert_nextcode_public_fun_args_to_treecode in src/lib/compiler/back/low/main/nextcode/convert-nextcode-fun-args-to-treecode-g.pkg };
Type = typ::Type;
package p {
#
Number_Kind_And_Size
#
= INT Int # Fixed-length signed-integer type.
| UNT Int # Fixed-length unsigned-integer type.
| FLOAT Int # Fixed-length floating-point type.
;
Arithop
= ADD
| SUBTRACT
| MULTIPLY
#
| DIVIDE # Round-to-zero division -- this is the native instruction on Intel32.
| DIV # Round-to-negative-infinity division -- this will be much slower on Intel32, has to be faked.
#
| REM # Round-to-zero remainder -- this is the native instruction on Intel32.
| MOD # Round-to-negative-infinity remainder -- this will be much slower on Intel32, has to be faked.
#
| NEGATE
| ABS
| FSQRT
| FSIN
| FCOS
| FTAN
| LSHIFT
| RSHIFT
| RSHIFTL
| BITWISE_AND
| BITWISE_OR
| BITWISE_XOR
| BITWISE_NOT
;
Compare_Op = GT | GE | LT | LE | EQL | NEQ;
# fcmpop conforms to the IEEE std 754 predicates.
#
package f {
Ieee754_Floating_Point_Compare_Op
= EQ # =
| ULG # ?<>
| UN # ?
| LEG # <=>
| GT # >
| GE # >=
| UGT # ?>
| UGE # ?>=
| LT # <
| LE # <=
| ULT # ?<
| ULE # ?<=
| LG # <>
| UE # ?=
;
};
Ieee754_Floating_Point_Compare_Op = f::Ieee754_Floating_Point_Compare_Op;
# These are two-way branches
# dependent on pure inputs.
# See comments in src/lib/compiler/back/top/nextcode/nextcode-form.api #
Branch
= COMPARE { op: Compare_Op, kind_and_size: Number_Kind_And_Size } # numkind cannot be FLOAT
| COMPARE_FLOATS { op: Ieee754_Floating_Point_Compare_Op, size: Int }
#
| IS_BOXED
| IS_UNBOXED
#
| POINTER_EQL
| POINTER_NEQ
#
| STRING_EQL
| STRING_NEQ
;
# streq (n, a, b) is defined only if strings a and b have
# exactly the same length n > 1
# These overwrite existing values in ram.
# (The "ram" might possibly be cached in registers.)
#
Store_To_Ram
= SET_VECSLOT_TO_NUMERIC_VALUE { kind_and_size: Number_Kind_And_Size }
| SET_VECSLOT_TO_TAGGED_INT_VALUE
| SET_VECSLOT_TO_BOXED_VALUE # Produces same code as next; used to store String and Float64 values into a vector.
| RW_VECTOR_SET # v[i] := w -- overwrites i-th slot in vector v.
| SET_REFCELL # a := v
| SET_REFCELL_TO_TAGGED_INT_VALUE # a := v. -- Tagged_Int-refcell stores are special because they don't need to be logged for the heapcleaner.
| SET_EXCEPTION_HANDLER_REGISTER
| SET_CURRENT_MICROTHREAD_REGISTER # Dedicated 'register'. (Actually in ram on intel32.)
| USELVAR
| SET_STATE_OF_WEAK_POINTER_OR_SUSPENSION
| FREE
| ACCLINK
| PSEUDOREG_SET
| SETMARK
| SET_NONHEAP_RAM { kind_and_size: Number_Kind_And_Size } # Store into non-heap ram.
| SET_NONHEAP_RAMSLOT Type # v[i] := w -- 64-bit writes for FLOAT64, 32-bit writes otherwise.
;
# These fetch from the store, never
# have functions as arguments:
#
Fetch_From_Ram
= GET_REFCELL_CONTENTS
| GET_VECSLOT_CONTENTS
| GET_VECSLOT_NUMERIC_CONTENTS { kind_and_size: Number_Kind_And_Size }
| GET_STATE_OF_WEAK_POINTER_OR_SUSPENSION
| DEFLVAR
| GET_RUNTIME_ASM_PACKAGE_RECORD
| GET_EXCEPTION_HANDLER_REGISTER
| GET_CURRENT_MICROTHREAD_REGISTER
| PSEUDOREG_GET
| GET_FROM_NONHEAP_RAM { kind_and_size: Number_Kind_And_Size }
;
# These might raise exception exceptions, never
# have functions as arguments:
#
Arith
= ARITH { op: Arithop, kind_and_size: Number_Kind_And_Size }
| SHRINK_INT (Int, Int)
| SHRINK_UNT (Int, Int)
| SHRINK_INTEGER Int
| ROUND { floor: Bool, from: Number_Kind_And_Size, to: Number_Kind_And_Size }
;
# These don't raise exceptions
# and don't access the store:
#
Pure
= PURE_ARITH { op: Arithop, kind_and_size: Number_Kind_And_Size }
| PURE_GET_VECSLOT_NUMERIC_CONTENTS { kind_and_size: Number_Kind_And_Size }
| VECTOR_LENGTH_IN_SLOTS
| HEAPCHUNK_LENGTH_IN_WORDS # Length excludes tagword itself.
| MAKE_REFCELL
| STRETCH (Int, Int)
| CHOP (Int, Int)
| COPY (Int, Int)
| STRETCH_TO_INTEGER Int
| CHOP_INTEGER Int
| COPY_TO_INTEGER Int
| CONVERT_FLOAT { from: Number_Kind_And_Size, to: Number_Kind_And_Size }
| RO_VECTOR_GET
| GET_BATAG_FROM_TAGWORD
| MAKE_WEAK_POINTER_OR_SUSPENSION
| WRAP
| UNWRAP
| CAST
| GETCON
| GETEXN
| WRAP_FLOAT64 # Float
| UNWRAP_FLOAT64 # Float
| IWRAP # Int
| IUNWRAP # Int
| WRAP_INT1
| UNWRAP_INT1
| GETSEQDATA
| RECORD_GET
| RAW64_GET
| MAKE_ZERO_LENGTH_VECTOR
| ALLOT_RAW_RECORD Null_Or( Record_Kind ) # Allocate uninitialized words from the heap.
| CONDITIONAL_LOAD Branch
;
stipulate
fun ioper (GT : Compare_Op) => (LE : Compare_Op);
ioper LE => GT;
ioper LT => GE;
ioper GE => LT;
ioper EQL => NEQ;
ioper NEQ => EQL;
end;
fun foper f::EQ => f::ULG;
foper f::ULG => f::EQ;
foper f::GT => f::ULE;
foper f::GE => f::ULT;
foper f::LT => f::UGE;
foper f::LE => f::UGT;
foper f::LG => f::UE;
foper f::LEG => f::UN;
foper f::UGT => f::LE;
foper f::UGE => f::LT;
foper f::ULT => f::GE;
foper f::ULE => f::GT;
foper f::UE => f::LG;
foper f::UN => f::LEG;
end;
herein
fun opp IS_BOXED => IS_UNBOXED;
opp IS_UNBOXED => IS_BOXED;
#
opp STRING_NEQ => STRING_EQL;
opp STRING_EQL => STRING_NEQ;
#
opp POINTER_EQL => POINTER_NEQ;
opp POINTER_NEQ => POINTER_EQL;
#
opp (COMPARE { op, kind_and_size } ) => COMPARE { op=>ioper op, kind_and_size };
opp (COMPARE_FLOATS { op, size } ) => COMPARE_FLOATS { op=>foper op, size };
end;
end;
iadd = ARITH { op => ADD, kind_and_size=>INT 31 };
isub = ARITH { op => SUBTRACT, kind_and_size=>INT 31 };
imul = ARITH { op => MULTIPLY, kind_and_size=>INT 31 };
idiv = ARITH { op => DIVIDE, kind_and_size=>INT 31 };
ineg = ARITH { op => NEGATE, kind_and_size=>INT 31 };
fadd = ARITH { op => ADD, kind_and_size=>FLOAT 64 };
fsub = ARITH { op => SUBTRACT, kind_and_size=>FLOAT 64 };
fmul = ARITH { op => MULTIPLY, kind_and_size=>FLOAT 64 };
fdiv = ARITH { op => DIVIDE, kind_and_size=>FLOAT 64 };
fneg = ARITH { op => NEGATE, kind_and_size=>FLOAT 64 };
ieql = COMPARE { op=>EQL, kind_and_size=>INT 31 };
ineq = COMPARE { op=>NEQ, kind_and_size=>INT 31 };
igt = COMPARE { op=>GT, kind_and_size=>INT 31 };
ige = COMPARE { op=>GE, kind_and_size=>INT 31 };
ile = COMPARE { op=>LE, kind_and_size=>INT 31 };
ilt = COMPARE { op=>LT, kind_and_size=>INT 31 };
# iltu = COMPARE { op=>LTU, kind_and_size=>INT 31 }
# igeu = COMPARE { op=>GEU, kind_and_size=>INT 31 }
feql = COMPARE_FLOATS { op=>f::EQ, size=>64 };
fneq = COMPARE_FLOATS { op=>f::LG, size=>64 };
fgt = COMPARE_FLOATS { op=>f::GT, size=>64 };
fge = COMPARE_FLOATS { op=>f::GE, size=>64 };
fle = COMPARE_FLOATS { op=>f::LE, size=>64 };
flt = COMPARE_FLOATS { op=>f::LT, size=>64 };
fun arity NEGATE => 1;
arity _ => 2;
end;
}; # package p
Codetemp = tmp::Codetemp;
Value
= CODETEMP Codetemp
| LABEL Codetemp
| INT Int
| INT1 one_word_unt::Unt
| FLOAT64 String
| STRING String
| CHUNK unsafe::unsafe_chunk::Chunk
| TRUEVOID
;
Fieldpath # How do we access the value of a given RECORD slot?
= SLOT Int # Directly, as slot six or whatever.
| VIA_SLOT (Int, Fieldpath) # Indirectly through a series of fetches, starting with slot six or whatever.
;
# See copious comments in: src/lib/compiler/back/top/nextcode/nextcode-form.api #
Callers_Info
= FATE_FN # Fate ("continuation") functions. Fate functions are never recursive; there is at most one per ncf::DEFINE_FUNS.
| PRIVATE_FN # A fun is 'private' if we known all possible callers -- this lets us optimize the calling register conventions for it.
| PRIVATE_RECURSIVE_FN # Private recursive functions.
| PRIVATE_FN_WHICH_NEEDS_HEAPLIMIT_CHECK # Private functions that need a heap limit check.
| PRIVATE_TAIL_RECURSIVE_FN # Private tail-recursive kernel functions.
| PRIVATE_FATE_FN # Private fate ("continuation") functions.
| PUBLIC_FN # Before the closure phase: any user function; After the closure phase: Any externally visible fun. (=> requires std call protocol.)
| NO_INLINE_INTO
;
Instruction # One or more instructions chained through 'next'.
#
= DEFINE_RECORD # Create a 'kind' record with 'fields', store it in 'to_temp', then execute 'next'.
{ kind: Record_Kind, # record / fate / ...
fields: List( (Value, Fieldpath) ),
to_temp: Codetemp,
next: Instruction # Next instruction to execute.
}
| GET_FIELD_I # Store field 'i' of 'record' in ('to_temp': 'type'), then execute 'next'.
{ i: Int,
record: Value,
to_temp: Codetemp,
type: Type,
next: Instruction # Next instruction to execute.
}
| GET_ADDRESS_OF_FIELD_I # Store address of field 'i' of 'record' in ('to_temp': 'type'), then execute 'next'.
{ i: Int,
record: Value,
to_temp: Codetemp,
next: Instruction # Next instruction to execute.
}
| TAIL_CALL # Apply 'fn' to 'args'. Nextcode fns don't return so there is no 'next' field -- this is essentially a "jump with arguments".
{
fn: Value,
args: List(Value)
}
| DEFINE_FUNS # Define 'funs', then execute 'next'. Often a single fun is defined, but potentially a set of mutually recursive fns.
{
funs: List(Function),
next: Instruction
}
| JUMPTABLE # Evaluate i-th of N nexts. xvar is used for def/use accounting -- created fresh at start of nextcode, discarded at end.
{
i: Value,
xvar: Codetemp,
nexts: List(Instruction)
}
| IF_THEN_ELSE # If 'op'('args') do 'then_next' else 'else_next'.
{ op: p::Branch, # Specifies comparison (GT, LE...), bit resolution etc.
args: List(Value),
xvar: Codetemp, # xvar is for branch-probability estimation via def/use accounting -- created at start of nextcode, discarded at end.
then_next: Instruction, # Next instruction to execute if condition is TRUE.
else_next: Instruction # Next instruction to execute if condition is FALSE.
}
| STORE_TO_RAM
{ op: p::Store_To_Ram, # Are we storing into a refcell, rw_vector, or something weird? Are we storing a pointer or an immediate value?
args: List(Value), # Actual value to store.
next: Instruction # Next instruction to execute.
}
| FETCH_FROM_RAM # Store 'op'('args') in ('to_temp': 'type'), then execute 'next'. Our 'op' never has functions as arguments.
{ op: p::Fetch_From_Ram, # Are we fetching from a refcell, rw_vector, globally allocated register...?
args: List(Value), # Typically [v,i] if we're fetching v[i] -- depends on 'op'.
to_temp: Codetemp, # We publish fetch result under this name during execution of 'fate'.
type: Type, # We publish fetch result under this type during execution of 'fate'.
next: Instruction # Next instruction to execute.
}
| ARITH # Store 'op'('args') in ('to_temp': 'type'), then execute of 'next'.
{ op: p::Arith,
args: List(Value),
to_temp: Codetemp,
type: Type,
next: Instruction # Next instruction to execute.
}
| PURE # Store 'op'('args') in ('to_temp': 'type'), then execute of 'next'.
{ op: p::Pure,
args: List(Value),
to_temp: Codetemp,
type: Type,
next: Instruction # Next instruction to execute.
}
| RAW_C_CALL # Invoke C function 'linkage' with 'args', publish return values as 'results' during execution of 'fate'.
{
kind: Rcc_Kind,
cfun_name: String,
cfun_type: cty::Cfun_Type, # Either "" or else linkage info as "shared_library_name/name_of_the_C_function".
args: List(Value),
to_ttemps: List( (Codetemp, Type) ), # Like 'to_temp' above, but a list of (Codetemp,Type) pairs instead of a single Codetemp.
next: Instruction # Next instruction to execute.
}
#
# Experimental "raw C call" (Blume, 1/2001) -- see comments in src/lib/compiler/back/top/nextcode/nextcode-form.api also
Rcc_Kind
=
FAST_RCC | REENTRANT_RCC
withtype
Function
=
( Callers_Info, # E.g., if all callers are known, we can construct a custom calling convention for better time and space performance.
Codetemp,
List( Codetemp ),
List( Type ),
Instruction
);
fun has_raw_c_call cexp
=
case cexp
#
RAW_C_CALL _ => TRUE;
TAIL_CALL _ => FALSE;
#
DEFINE_RECORD { next, ... } => has_raw_c_call next;
GET_FIELD_I { next, ... } => has_raw_c_call next;
GET_ADDRESS_OF_FIELD_I { next, ... } => has_raw_c_call next;
STORE_TO_RAM { next, ... } => has_raw_c_call next;
FETCH_FROM_RAM { next, ... } => has_raw_c_call next;
ARITH { next, ... } => has_raw_c_call next;
PURE { next, ... } => has_raw_c_call next;
#
IF_THEN_ELSE { then_next, else_next, ... } => has_raw_c_call then_next
or has_raw_c_call else_next;
#
JUMPTABLE { nexts, ... } => check_list nexts;
#
DEFINE_FUNS { funs, next }
=>
has_raw_c_call next
or
check_list
(map (\\ (_, _, _, _, e) = e) funs);
esac
where
fun check_list (c ! rest) => has_raw_c_call (c) or check_list (rest);
check_list [] => FALSE;
end;
end;
fun size_in_bits typ::FLOAT64 => 64;
size_in_bits ( typ::INT
| typ::INT1
| typ::POINTER _
| typ::FUN
| typ::FATE
| typ::DSP
) => 32; # 64-bit issue XXX BUGGO FIXME
end;
fun is_float typ::FLOAT64 => TRUE;
is_float ( typ::INT
| typ::INT1
| typ::POINTER _
| typ::FUN
| typ::FATE
| typ::DSP
) => FALSE;
end;
fun is_tagged ( typ::FLOAT64
| typ::INT1
) => FALSE;
is_tagged ( typ::INT
| typ::POINTER _
| typ::FUN
| typ::FATE
| typ::DSP
) => TRUE;
end;
fun cty_to_string typ::INT => "[I]";
cty_to_string typ::INT1 => "[I32]";
cty_to_string typ::FLOAT64 => "[R]";
cty_to_string (typ::POINTER (RPT k)) => ("[PR" + (int::to_string (k)) + "]");
cty_to_string (typ::POINTER (FPT k)) => ("[PF" + (int::to_string (k)) + "]");
cty_to_string (typ::POINTER VPT ) => "[PV]";
cty_to_string typ::FUN => "[F]";
cty_to_string typ::FATE => "[C]";
cty_to_string typ::DSP => "[D]";
end;
fun combinepaths (p, SLOT 0)
=>
p;
combinepaths (p, q)
=>
comb p
where
recursive my comb
=
\\ (SLOT 0)
=>
q;
(SLOT i)
=>
case q
(SLOT j) => SLOT (i+j);
(VIA_SLOT (j, p)) => VIA_SLOT (i+j, p);
esac;
(VIA_SLOT (i, p))
=>
VIA_SLOT (i, comb p);
end;
end;
end;
fun lenp (SLOT _) => 0;
lenp (VIA_SLOT(_, p)) => 1 + lenp p;
end;
bogus_pointer_type = typ::POINTER VPT; # Bogus pointer type whose length is unknown
stipulate
package hcf = highcode_form; # highcode_form is from src/lib/compiler/back/top/highcode/highcode-form.pkg #
tc_float64 = hcf::float64_uniqtype;
lt_float64 = hcf::float64_uniqtypoid;
herein
fun tcflt tc = if (hcf::same_uniqtype (tc, tc_float64)) TRUE; else FALSE; fi;
fun ltflt lt = if (hcf::same_uniqtypoid (lt, lt_float64)) TRUE; else FALSE; fi;
fun rtyc (f, []) => RPT 0;
rtyc (f, ts)
=>
loop (ts, TRUE, 0)
where
fun loop (a ! r, b, len)
=>
if (f a) loop (r, b, len+1);
else loop (r, FALSE, len+1);
fi;
loop ([], b, len)
=>
if b FPT len;
else RPT len;
fi;
end;
end;
end;
fun uniqtype_to_nextcode tc
=
hcf::if_uniqtype_is_basetype (
tc,
\\ pt = if (pt == hbt::basetype_tagged_int) typ::INT;
elif (pt == hbt::basetype_int1) typ::INT1;
elif (pt == hbt::basetype_float64) typ::FLOAT64;
else bogus_pointer_type;
fi,
\\ tc
=
hcf::if_uniqtype_is_tuple (
tc,
\\ ts = typ::POINTER (rtyc (tcflt, ts)),
\\ tc = if (hcf::uniqtype_is_arrow tc) typ::FUN;
elif (hcf::uniqtype_is_fate tc) typ::FATE;
else bogus_pointer_type;
fi
)
);
fun uniqtypoid_to_nextcode_type lt
=
hcf::if_uniqtypoid_is_type (
lt,
\\ tc = uniqtype_to_nextcode tc,
\\ lt = hcf::if_uniqtypoid_is_package (
lt,
\\ ts = typ::POINTER (rtyc (\\ _ = FALSE, ts)),
\\ lt = if (hcf::uniqtypoid_is_generic_package lt) typ::FUN;
elif (hcf::uniqtypoid_is_fate lt) typ::FATE;
else bogus_pointer_type;
fi
)
);
end; # stipulate
}; # package nextcode
end; # stipulate