## base-types-and-ops.pkg
# Compiled by:
# src/lib/compiler/core.sublib# This module defines various foundation-of-the-universe things
# like 'Bool' which must be predefined in order to bootstrap
# everything else.
#
# There is special logic in
#
# src/app/makelib/mythryl-compiler-compiler/process-mythryl-primordial-library.pkg#
# to make base_types_and_ops available to
# any module flagged with "primitive" in
#
# src/lib/core/init/init.cmi
#
# Actually implementing this is done in
#
# src/app/makelib/compile/compile-in-dependency-order-g.pkg#
# using the 'extra_static_compile_dictionary' parameter
# hacked in specifically for the purpose.
#
#
# Here we in particular define the 'inline' package containing
# the various basic arithmetic functions like add, multiply ...
# and various basic vector functions like get, set ...
#
# These get used in
#
# src/lib/core/init/built-in.pkg#
# to populate the packages
#
# float64
# multiword_int
# one_word_unt
# two_word_unt
# one_word_int
# tagged_unt
# tagged_int
# two_word_int
# one_byte_unt
# char
#
# poly_rw_vector
# poly_vector
# rw_vector_of_eight_byte_floats
# vector_of_eight_byte_floats
# rw_vector_of_one_byte_unts
# vector_of_one_byte_unts
# rw_vector_of_chars
# vector_of_chars
#
# with type-appropriate add/multiply... (or get/set...) functions.
### "I have struck a city -- a real
### city -- and they call it Chicago...
### I urgently desire never to see it again.
### It is inhabited by savages."
###
### -- Rudyard Kipling
api Base_Types_And_Ops {
#
base_types_and_ops_symbolmapstack: symbolmapstack::Symbolmapstack;
};
stipulate
package err = error_message; # error_message is from src/lib/compiler/front/basics/errormsg/error-message.pkg package hbo = highcode_baseops; # highcode_baseops is from src/lib/compiler/back/top/highcode/highcode-baseops.pkg package ip = inverse_path; # inverse_path is from src/lib/compiler/front/typer-stuff/basics/symbol-path.pkg package ij = inlining_junk; # inlining_junk is from src/lib/compiler/front/semantic/basics/inlining-junk.pkg package mld = module_level_declarations; # module_level_declarations is from src/lib/compiler/front/typer-stuff/modules/module-level-declarations.pkg package mj = module_junk; # module_junk is from src/lib/compiler/front/typer-stuff/modules/module-junk.pkg package pkj = pickler_junk; # pickler_junk is from src/lib/compiler/front/semantic/pickle/pickler-junk.pkg package ppl = package_property_lists; # package_property_lists is from src/lib/compiler/front/semantic/modules/package-property-lists.pkg package sp = symbol_path; # symbol_path is from src/lib/compiler/front/typer-stuff/basics/symbol-path.pkg package sta = stamp; # stamp is from src/lib/compiler/front/typer-stuff/basics/stamp.pkg package sxe = symbolmapstack_entry; # symbolmapstack_entry is from src/lib/compiler/front/typer-stuff/symbolmapstack/symbolmapstack-entry.pkg package stx = stampmapstack; # stampmapstack is from src/lib/compiler/front/typer-stuff/modules/stampmapstack.pkg package sy = symbol; # symbol is from src/lib/compiler/front/basics/map/symbol.pkg package syx = symbolmapstack; # symbolmapstack is from src/lib/compiler/front/typer-stuff/symbolmapstack/symbolmapstack.pkg package tro = typerstore; # typerstore is from src/lib/compiler/front/typer-stuff/modules/typerstore.pkg package mtt = more_type_types; # more_type_types is from src/lib/compiler/front/typer/types/more-type-types.pkg package tdt = type_declaration_types; # type_declaration_types is from src/lib/compiler/front/typer-stuff/types/type-declaration-types.pkg package vh = varhome; # varhome is from src/lib/compiler/front/typer-stuff/basics/varhome.pkgherein
package base_types_and_ops
: (weak) Base_Types_And_Ops # Base_Types_And_Ops is from src/lib/compiler/front/semantic/symbolmapstack/base-types-and-ops.pkg {
# Note: this function only applies to constructors but not exceptions;
# exceptions will have a non-trivial slot number
fun make_constructor_element (name, sumtype)
=
( sy::make_value_symbol name,
#
mld::VALCON_IN_API { sumtype, slot => NULL }
);
# Below there are some very long list literals which would create
# huge register pressure on the compiler. We construct them backwards
# using an alternative "cons" that takes its two arguments in opposite
# order. This effectively puts the lists' ends to the left and alleviates
# this effect. (Stupid ML trick No. 21b) (Blume, 1/2001)
infix my :-: ; # inverse '!' op.
fun l :-: e
=
e ! l;
base_types_package_record
=
{
# Nomenclature:
#
# type
#
# refers to the Type (vs Typoid) type defined in
#
# src/lib/compiler/front/typer-stuff/types/type-declaration-types.pkg #
prim_types # "prim" == "primitive", in the sense of "no substructure", not "unsophisticated".
=
[] :-:
("Bool", mtt::bool_type ) :-:
("List", mtt::list_type ) :-:
#
("Ref", mtt::ref_type ) :-:
("Void", mtt::void_type ) :-:
#
("Int", mtt::int_type ) :-:
("Int1", mtt::int1_type ) :-:
("Int2", mtt::int2_type ) :-:
("Multiword_Int", mtt::multiword_int_type ) :-:
#
("Float", mtt::float64_type ) :-:
#
("Unt", mtt::unt_type ) :-:
("Unt8", mtt::unt8_type ) :-:
("Unt1", mtt::unt1_type ) :-:
("Unt2", mtt::unt2_type ) :-:
#
("Fate", mtt::fate_type ) :-:
("Control_Fate", mtt::control_fate_type ) :-:
#
("Rw_Vector", mtt::rw_vector_type ) :-:
("Vector", mtt::ro_vector_type ) :-:
("Unt8_Rw_Vector", mtt::un8_rw_vector_type ) :-:
("Float64_Rw_Vector", mtt::float64_rw_vector_type ) :-:
#
("Chunk", mtt::chunk_type ) :-:
("Cfunction", mtt::c_function_type ) :-:
#
("String", mtt::string_type ) :-:
("Char", mtt::char_type ) :-:
#
("Exception", mtt::exception_type ) :-:
#
("Spin_Lock", mtt::spinlock_type ) :-:
("Antiquote_Fragment", mtt::antiquote_fragment_type ) :-:
("Suspension", mtt::suspension_type )
;
prim_cons
=
[] :-:
("TRUE", mtt::true_valcon ) :-:
("FALSE", mtt::false_valcon ) :-:
("!", mtt::cons_valcon ) :-:
#
("NIL", mtt::nil_valcon ) :-:
("REF", mtt::ref_valcon ) :-:
#
("QUOTE", mtt::quote_valcon ) :-: # These three support a nonstandard + undocumented antiquote language extension.
("ANTIQUOTE", mtt::antiquote_valcon ) :-:
("@@@", mtt::dollar_valcon )
;
# To do:
#
# At some point it would be nice to have
# Ro_Ref -- a read-only version of Ref where
#
# *ref
#
# is allowed but not
#
# ref := ... ;
#
# In concurrent code, this would allow us to publish stuff
# via an Ro_Ref while having typesafe assurance that the
# the single thread retaining a Ref version of the refcell
# is the only one entitled to modify it. This would provide
# essentially a lighter weight alternative to Maildrop.
#
# Presumably we would do this by doing
# Ro_Ref = Ref; # Probably at a higher level than this file
# and then exporting Ro_Ref as opaque plus
# exporting a Ref -> Ro_Ref cast operator
# together with dereference ops on both types
# and finally making prefix '*' overloaded on both deref ops...?
#
# XXX BUGGO FIXME.
con_elements = map make_constructor_element prim_cons;
tyc_elements = map make_type_element prim_types
where
fun make_type_element (name: String, type)
=
( sy::make_type_symbol name,
#
mld::TYPE_IN_API { type,
module_stamp => sta::make_static_stamp name,
is_a_replica => FALSE,
scope => 0
}
);
end;
all_elements = tyc_elements @ con_elements;
all_symbols = map #1 all_elements;
typerstore
=
fold_backward f tro::empty tyc_elements
where
fun f ((_, mld::TYPE_IN_API { type, module_stamp, is_a_replica, scope } ), r)
=>
tro::set (r, module_stamp, mld::TYPE_ENTRY type);
f _ => err::impossible "primTypes: typerstore";
end;
end;
typerstore
=
typerstore::mark (\\ _ = sta::make_static_stamp "primMacroExpansionDict", typerstore);
api_record
=
{ stamp => sta::make_static_stamp "Base_Types_Api",
name => THE (sy::make_api_symbol "Base_Types"),
closed => TRUE,
#
symbols => all_symbols,
api_elements => all_elements,
#
contains_generic => FALSE,
type_sharing => NIL,
package_sharing => NIL,
#
property_list => property_list::make_property_list (),
stub => NULL
};
ppl::set_api_bound_generic_evaluation_paths (api_record, THE []);
package_record
=
{ an_api => mld::API api_record,
varhome => vh::null_varhome,
inlining_data => ij::make_inlining_data_list [],
#
typechecked_package => { stamp => sta::make_static_stamp "base_types_package",
stub => NULL,
typerstore,
#
property_list => property_list::make_property_list (),
inverse_path => ip::INVERSE_PATH [sy::make_package_symbol "base_types"]
}
};
mld::A_PACKAGE package_record;
}; # base_types_package_record
/**************************************************************************
* BUILDING A COMPLETE LIST OF PRIMOPS *
**************************************************************************/
stipulate
stipulate
fun bits_op size op = hbo::ARITH { op, overflow=>FALSE, kind_and_size=>hbo::INT size };
herein
bits31_op = bits_op 31; # 64-bit issue: This will become 63 on 64-bit implementations.
bits32_op = bits_op 32; # 64-bit issue: This will become 64 on 64-bit implementations.
end;
stipulate
fun int_op size op = hbo::ARITH { op, overflow=>TRUE, kind_and_size=>hbo::INT size };
herein
tagged_int_op = int_op 31; # 64-bit issue: This will become 63 on 64-bit implementations.
int1_op = int_op 32; # 64-bit issue: This will become 64 on 64-bit implementations.
end;
stipulate
fun unt_op size op = hbo::ARITH { op, overflow=>FALSE, kind_and_size=>hbo::UNT size }; # "unt" == "unsigned int".
herein
unt1_op = unt_op 32; # 64-bit issue: This will become 64 on 64-bit implementations.
tagged_unt_op = unt_op 31; # 64-bit issue: This will become 63 on 64-bit implementations.
unt8_op = unt_op 8;
end;
stipulate
fun purefloat_op size op = hbo::ARITH { op, overflow=>FALSE, kind_and_size=>hbo::FLOAT size };
herein
purefloat64_op = purefloat_op 64;
end;
stipulate
fun cmp_op kind_and_size op = hbo::COMPARE { op, kind_and_size };
herein
tagged_intcmp_op = cmp_op (hbo::INT 31); # 64-bit issue: This will become 63 on 64-bit implementations.
int1cmp_op = cmp_op (hbo::INT 32); # 64-bit issue: This will become 64 on 64-bit implementations.
unt1_cmp_op = cmp_op (hbo::UNT 32); # 64-bit issue: This will become 64 on 64-bit implementations.
tagged_unt_cmp_op = cmp_op (hbo::UNT 31); # 64-bit issue: This will become 63 on 64-bit implementations.
unt8cmp_op = cmp_op (hbo::UNT 8);
float64cmp_op = cmp_op (hbo::FLOAT 64);
end;
arg0 = tdt::TYPESCHEME_ARG 0;
arg1 = tdt::TYPESCHEME_ARG 1;
arg2 = tdt::TYPESCHEME_ARG 2;
tuple = mtt::tuple_typoid;
fun arrow (t1, t2) = mtt::(-->) (t1, t2);
fun ap (tc, l) = tdt::TYPCON_TYPOID (tc, l);
fun count t = tdt::TYPCON_TYPOID (mtt::fate_type, [t]);
fun ccnt t = tdt::TYPCON_TYPOID (mtt::control_fate_type, [t]);
fun rf t = tdt::TYPCON_TYPOID (mtt::ref_type, [t]);
fun rw_vector t = tdt::TYPCON_TYPOID (mtt::rw_vector_type, [t]);
fun ro_vector t = tdt::TYPCON_TYPOID (mtt::ro_vector_type, [t]);
void = mtt::void_typoid;
bool = mtt::bool_typoid;
int = mtt::int_typoid;
i32 = mtt::int1_typoid;
i64 = mtt::int2_typoid;
multiword_int = mtt::multiword_int_typoid;
u8 = mtt::unt8_typoid;
unt = mtt::unt_typoid;
u32 = mtt::unt1_typoid;
u64 = mtt::unt2_typoid;
f64 = mtt::float64_typoid;
string = mtt::string_typoid;
fun p0 t = t;
fun p1 t = tdt::TYPESCHEME_TYPOID { typescheme_eqflags => [FALSE], typescheme=>tdt::TYPESCHEME { arity=>1, body=>t }};
fun ep1 t = tdt::TYPESCHEME_TYPOID { typescheme_eqflags => [TRUE], typescheme=>tdt::TYPESCHEME { arity=>1, body=>t }}; # We use ep1 (only) for (==) and (!=).
fun p2 t = tdt::TYPESCHEME_TYPOID { typescheme_eqflags => [FALSE, FALSE], typescheme=>tdt::TYPESCHEME { arity=>2, body=>t }};
fun p3 t = tdt::TYPESCHEME_TYPOID { typescheme_eqflags => [FALSE, FALSE, FALSE], typescheme=>tdt::TYPESCHEME { arity=>3, body=>t }};
fun rw_vector_get kind_and_size = hbo::GET_VECSLOT_NUMERIC_CONTENTS { kind_and_size, checkbounds=>FALSE, immutable=>FALSE };
fun rw_vector_get_with_boundscheck kind_and_size = hbo::GET_VECSLOT_NUMERIC_CONTENTS { kind_and_size, checkbounds=>TRUE, immutable=>FALSE };
fun ro_vector_get kind_and_size = hbo::GET_VECSLOT_NUMERIC_CONTENTS { kind_and_size, checkbounds=>FALSE, immutable=>TRUE };
fun ro_vector_get_with_boundscheck kind_and_size = hbo::GET_VECSLOT_NUMERIC_CONTENTS { kind_and_size, checkbounds=>TRUE, immutable=>TRUE };
fun rw_vector_set kind_and_size = hbo::SET_VECSLOT_TO_NUMERIC_VALUE { kind_and_size, checkbounds=>FALSE };
fun rw_vector_set_with_boundscheck kind_and_size = hbo::SET_VECSLOT_TO_NUMERIC_VALUE { kind_and_size, checkbounds=>TRUE };
num_vector_get_type = p2 (arrow (tuple [arg0, int], arg1));
num_vector_set_type = p2 (arrow (tuple [arg0, int, arg1], void ));
fun unf t = p0 (arrow (t, t));
fun binf t = p0 (arrow (tuple [t, t], t));
fun binp t = p0 (arrow (tuple [t, t], bool));
fun shifter t = p0 (arrow (tuple [t, unt], t));
u32_i32 = p0 (arrow (u32, i32));
u32_f64 = p0 (arrow (u32, f64));
u32u32_u = p0 (arrow (tuple [u32, u32], void));
u32i32_u = p0 (arrow (tuple [u32, i32], void));
u32f64_u = p0 (arrow (tuple [u32, f64], void));
i_x = p1 (arrow (int, arg0));
xu32_u32 = p1 (arrow (tuple [arg0, u32], u32));
xu32_i32 = p1 (arrow (tuple [arg0, u32], i32));
xu32_f64 = p1 (arrow (tuple [arg0, u32], f64));
xu32u32_u = p1 (arrow (tuple [arg0, u32, u32], void));
xu32i32_u = p1 (arrow (tuple [arg0, u32, i32], void));
xu32f64_u = p1 (arrow (tuple [arg0, u32, f64], void));
b_b = unf bool;
f64_i = p0 (arrow (f64, int));
i_f64 = p0 (arrow (int, f64));
i32_f64 = p0 (arrow (i32, f64));
u32_i = p0 (arrow (u32, int));
i32_i = p0 (arrow (i32, int));
i_i32 = p0 (arrow (int, i32));
i_u32 = p0 (arrow (int, u32));
u32_u = p0 (arrow (u32, unt));
i32_u = p0 (arrow (i32, unt)); # Unused.
u_u32 = p0 (arrow (unt, u32)); # Unused.
u_i32 = p0 (arrow (unt, i32));
u_i = p0 (arrow (unt, int));
i_u = p0 (arrow (int, unt));
u32_i32 = p0 (arrow (u32, i32));
i32_u32 = p0 (arrow (i32, u32));
i_i = unf int;
ii_i = binf int;
ii_b = binp int;
iu_i = shifter int;
u_u = unf unt;
uu_u = binf unt;
uu_b = binp unt;
i32_i32 = unf i32;
i32i32_i32 = binf i32;
i32i32_b = binp i32;
u32_u32 = unf u32;
u32u32_u32 = binf u32;
u32u32_b = binp u32;
u32u_u32 = shifter u32;
u8_u8 = unf u8;
u8u8_u8 = binf u8;
u8u8_b = binp u8;
u8w_u8 = shifter u8;
f64_f64 = unf f64;
f64f64_f64 = binf f64;
f64f64_b = binp f64;
u8_i = p0 (arrow (u8, int));
u8_i32 = p0 (arrow (u8, i32));
u8_u32 = p0 (arrow (u8, u32));
i_u8 = p0 (arrow (int, u8));
i32_u8 = p0 (arrow (i32, u8));
u32_u8 = p0 (arrow (u32, u8));
i0_i = p0 (arrow (multiword_int, int));
i0_i32 = p0 (arrow (multiword_int, i32));
i0_i64 = p0 (arrow (multiword_int, i64));
i0_u8 = p0 (arrow (multiword_int, u8));
i0_u = p0 (arrow (multiword_int, unt));
i0_u32 = p0 (arrow (multiword_int, u32));
i0_u64 = p0 (arrow (multiword_int, u64));
i_i0 = p0 (arrow (int, multiword_int));
i32_i0 = p0 (arrow (i32, multiword_int));
i64_i0 = p0 (arrow (i64, multiword_int));
u8_i0 = p0 (arrow (u8, multiword_int));
u_i0 = p0 (arrow (unt, multiword_int));
u32_i0 = p0 (arrow (u32, multiword_int));
u64_i0 = p0 (arrow (u64, multiword_int));
u64_pu32 = p0 (arrow (u64, tuple [u32, u32]));
pu32_u64 = p0 (arrow (tuple [u32, u32], u64));
i64_pu32 = p0 (arrow (i64, tuple [u32, u32]));
pu32_i64 = p0 (arrow (tuple [u32, u32], i64));
cc_b = binp mtt::char_typoid;
# The type of the RAW_CCALL baseop is
# (so far as the type checker is concerned):
#
# (One_Word_Unt, X, Y) -> W
#
# However, the baseop cannot be used without having
# X, Y, and Z monomorphically macro expanded. In particular:
# X will be the type of the ML argument list,
# Z will be the type of the result, and
# Y will be a type of a fake arguments.
# The idea is that Y will be macro expanded with some ML type that
# encodes the type of the actual C function in order to be able to
# generate code according to the C calling convention.
# (In other words, Y will be a completely ad-hoc encoding of a CTypes.c_proto
# value in ML types. The encoding also contains information about
# calling conventions and reentrancy.)
#
rcc_type = p3 (arrow (tuple [u32, arg0, arg1], arg2));
herein
# I made an effort to eliminate the cases where type info for primops
# is left NULL because this is, in fact, incorrect. (As long as they
# are left at NULL, there are correct ML programs that trigger internal
# compiler errors.)
#
# - Matthias Blume (1/2001)
# Many of these bindings are apparently never actually used;
# I gather the compiler typically uses the hbo:* directly
# during code generation, with this symbol table mainly providing
# sort of an inline-assembly capability for the end programmer:
# -- 2013-11-20 CrT
#
all_primops
=
[] :-:
("callcc", hbo::CALLCC, p1 (arrow (arrow (count (arg0), arg0), arg0))) :-:
("throw", hbo::THROW, p2 (arrow (count (arg0), arrow (arg0, arg1)))) :-:
("switch_to_control_fate", hbo::THROW, p2 (arrow (ccnt (arg0), arrow (arg0, arg1)))) :-:
#
("call_with_current_control_fate", hbo::CALL_WITH_CURRENT_CONTROL_FATE, p1 (arrow (arrow (ccnt (arg0), arg0), arg0))) :-:
("make_isolated_fate", hbo::MAKE_ISOLATED_FATE, p1 (arrow (arrow (arg0, void), count (arg0)))) :-:
#
(":=", hbo::SET_REFCELL, p1 (arrow (tuple [rf (arg0), arg0], void))) :-:
("deref", hbo::GET_REFCELL_CONTENTS, p1 (arrow (rf (arg0), arg0))) :-:
("makeref", hbo::MAKE_REFCELL, p1 (arrow (arg0, rf (arg0)))) :-:
#
("boxed", hbo::IS_BOXED, p1 (arrow (arg0, bool))) :-:
("unboxed", hbo::IS_UNBOXED, p1 (arrow (arg0, bool))) :-:
#
("cast", hbo::CAST, p2 (arrow (arg0, arg1))) :-:
#
("==", hbo::POLY_EQL, ep1 (arrow (tuple [arg0, arg0], bool))) :-:
("!=", hbo::POLY_NEQ, ep1 (arrow (tuple [arg0, arg0], bool))) :-:
#
("ptreql", hbo::POINTER_EQL, p1 (arrow (tuple [arg0, arg0], bool))) :-:
("ptrneq", hbo::POINTER_NEQ, p1 (arrow (tuple [arg0, arg0], bool))) :-:
# These two operate on threadkit's reserved 'current thread' register -- see
# src/lib/compiler/back/low/main/intel32/backend-lowhalf-intel32-g.pkg #
("get_current_microthread_register", hbo::GET_CURRENT_MICROTHREAD_REGISTER, p1 (arrow (void, arg0))) :-:
("set_current_microthread_register", hbo::SET_CURRENT_MICROTHREAD_REGISTER, p1 (arrow (arg0, void))) :-:
("setpseudo", hbo::PSEUDOREG_SET, p1 (arrow (tuple [arg0, int], void))) :-:
("getpseudo", hbo::PSEUDOREG_GET, p1 (arrow (int, arg0))) :-:
("make_special", hbo::MAKE_WEAK_POINTER_OR_SUSPENSION, p2 (arrow (tuple [int, arg0], arg1))) :-:
("getspecial", hbo::GET_STATE_OF_WEAK_POINTER_OR_SUSPENSION, p1 (arrow (arg0, int))) :-:
("setspecial", hbo::SET_STATE_OF_WEAK_POINTER_OR_SUSPENSION, p1 (arrow (tuple [arg0, int], void))) :-:
("gethandler", hbo::GET_EXCEPTION_HANDLER_REGISTER, p1 (arrow (void, count (arg0)))) :-:
("sethandler", hbo::SET_EXCEPTION_HANDLER_REGISTER, p1 (arrow (count (arg0), void))) :-:
("gettag", hbo::GET_BATAG_FROM_TAGWORD, p1 (arrow (arg0, int))) :-:
("setmark", hbo::SETMARK, p1 (arrow (arg0, void))) :-:
("dispose", hbo::DISPOSE, p1 (arrow (arg0, void))) :-:
("compose", hbo::COMPOSE_MACRO, p3 (arrow (tuple [arrow (arg1, arg2), arrow (arg0, arg1)], arrow (arg0, arg2)))) :-:
("then", hbo::THEN_MACRO, p2 (arrow (tuple [arg0, arg1], arg0))) :-:
("ignore", hbo::IGNORE_MACRO, p1 (arrow (arg0, void))) :-:
("identity", hbo::IDENTITY_MACRO, p1 (arrow (arg0, arg0))) :-:
("length", hbo::VECTOR_LENGTH_IN_SLOTS, p1 (arrow (arg0, int))) :-:
("chunklength", hbo::HEAPCHUNK_LENGTH_IN_WORDS, p1 (arrow (arg0, int))) :-:
# I believe the following five primops should not be exported into
# the inline package. (ZHONG)
# So we take them out... (Matthias)
# ("boxedupdate", hbo::SET_VECSLOT_TO_BOXED_VALUE, ?) :-:
# ("getrunvec", hbo::GET_RUNTIME_ASM_PACKAGE_RECORD, ?) :-:
# ("uselvar", hbo::USELVAR, ?) :-:
# ("deflvar", hbo::DEFLVAR, ?) :-:
# I put this one back in so
# add_per_fun_call_counters_to_deep_syntax # add_per_fun_call_counters_to_deep_syntax is from src/lib/compiler/debugging-and-profiling/profiling/add-per-fun-call-counters-to-deep-syntax.pkg # can find it in _Core instead of having to
# construct it ... (Matthias)
("unboxed_set", hbo::SET_VECSLOT_TO_TAGGED_INT_VALUE, p1 (arrow (tuple [rw_vector (arg0), int, arg0], void))) :-:
("not_macro", hbo::NOT_MACRO, b_b) :-: # Logical 'not' as a macro that gets expanded out.
("floor", hbo::ROUND { floor=>TRUE,
from=>hbo::FLOAT 64,
to=>hbo::INT 31 }, f64_i) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("round", hbo::ROUND { floor=>FALSE,
from=>hbo::FLOAT 64,
to=>hbo::INT 31 }, f64_i) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("tagged_int_to_float64", hbo::CONVERT_FLOAT { from=>hbo::INT 31,
to=>hbo::FLOAT 64 }, i_f64) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("int1_to_float64", hbo::CONVERT_FLOAT { from=>hbo::INT 32,
to=>hbo::FLOAT 64 }, i32_f64) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("ro_int8_vector_get", hbo::GET_VECSLOT_NUMERIC_CONTENTS { kind_and_size=>hbo::INT 8, checkbounds=>FALSE, immutable=>TRUE }, num_vector_get_type) :-: # fetch-from-immutable vector_of_one_byte_unts::get (rw_)vector_of_chars::get
("ro_int8_vector_get_with_boundscheck", hbo::GET_VECSLOT_NUMERIC_CONTENTS { kind_and_size=>hbo::INT 8, checkbounds=>TRUE, immutable=>TRUE }, num_vector_get_type) :-: # vector_of_one_byte_unts::get_with_boundscheck (rw_)vector_of_chars::get_with_boundscheck
#
("rw_int8_vector_get_with_boundscheck", hbo::GET_VECSLOT_NUMERIC_CONTENTS { kind_and_size=>hbo::INT 8, checkbounds=>TRUE, immutable=>FALSE}, num_vector_get_type) :-: # rw_vector_of_one_byte_unts::get_with_boundscheck
("rw_int8_vector_set", hbo::SET_VECSLOT_TO_NUMERIC_VALUE { kind_and_size=>hbo::INT 8, checkbounds=>FALSE }, num_vector_set_type) :-: # rw_vector_of_one_byte_unts::set
("rw_int8_vector_set_with_boundscheck", hbo::SET_VECSLOT_TO_NUMERIC_VALUE { kind_and_size=>hbo::INT 8, checkbounds=>TRUE }, num_vector_set_type) :-: # rw_vector_of_one_byte_unts::set_with_boundscheck
# Type-agnostic rw_vector and vector:
#
("make_nonempty_rw_vector", hbo::MAKE_NONEMPTY_RW_VECTOR_MACRO, p1 (arrow (tuple [int, arg0], rw_vector arg0))) :-:
#
("rw_vector_get", hbo::RW_VECTOR_GET, p1 (arrow (tuple [rw_vector arg0, int ], arg0))) :-:
("ro_vector_get", hbo::RO_VECTOR_GET, p1 (arrow (tuple [ro_vector arg0, int ], arg0))) :-:
("rw_vector_set", hbo::RW_VECTOR_SET, p1 (arrow (tuple [rw_vector arg0, int, arg0], void))) :-:
#
("rw_vector_get_with_boundscheck", hbo::RW_VECTOR_GET_WITH_BOUNDSCHECK, p1 (arrow (tuple [rw_vector arg0, int ], arg0))) :-:
("ro_vector_get_with_boundscheck", hbo::RO_VECTOR_GET_WITH_BOUNDSCHECK, p1 (arrow (tuple [ro_vector arg0, int ], arg0))) :-:
("rw_vector_set_with_boundscheck", hbo::RW_VECTOR_SET_WITH_BOUNDSCHECK, p1 (arrow (tuple [rw_vector arg0, int, arg0], void))) :-:
# Soon:
("rw_matrix_get", hbo::RW_MATRIX_GET_MACRO, p1 (arrow (tuple [tuple [rw_vector arg0, int, int], int], arg0))) :-:
("ro_matrix_get", hbo::RO_MATRIX_GET_MACRO, p1 (arrow (tuple [tuple [ro_vector arg0, int, int], int], arg0))) :-:
("rw_matrix_set", hbo::RW_MATRIX_SET_MACRO, p1 (arrow (tuple [tuple [rw_vector arg0, int, int], int, arg0], void))) :-:
#
("rw_matrix_get_with_boundscheck", hbo::RW_MATRIX_GET_WITH_BOUNDSCHECK_MACRO, p1 (arrow (tuple [tuple [rw_vector arg0, int, int], int], arg0))) :-:
("ro_matrix_get_with_boundscheck", hbo::RO_MATRIX_GET_WITH_BOUNDSCHECK_MACRO, p1 (arrow (tuple [tuple [ro_vector arg0, int, int], int], arg0))) :-:
("rw_matrix_set_with_boundscheck", hbo::RW_MATRIX_SET_WITH_BOUNDSCHECK_MACRO, p1 (arrow (tuple [tuple [rw_vector arg0, int, int], int, arg0], void))) :-:
# New rw_vector representations:
#
("make_zero_length_vector", hbo::MAKE_ZERO_LENGTH_VECTOR, p1 (arrow (void, arg0))) :-:
("get_vector_datachunk", hbo::GET_VECTOR_DATACHUNK, p2 (arrow (arg0, arg1))) :-:
("record_get", hbo::RECORD_GET, p2 (arrow (tuple [arg0, int], arg1))) :-:
("raw64_get", hbo::RAW64_GET, p1 (arrow (tuple [arg0, int], f64 ))) :-:
# Conversion primops.
# There are certain duplicates for the same
# baseop (but with different types).
# In such a case, the "canonical" name of the
# baseop has been extended using
# a simple suffix scheme:
#
("test_32_31_u", hbo::SHRINK_INT (32, 31), u32_i) :-: # 64-bit issue: These will become 64,63 on 64-bit implementations.
("test_32_31_i", hbo::SHRINK_INT (32, 31), i32_i) :-: # 64-bit issue: These will become 64,63 on 64-bit implementations.
("testu_31_31", hbo::SHRINK_UNT (31, 31), u_i) :-: # 64-bit issue: These will become 63,63 on 64-bit implementations.
("testu_32_31", hbo::SHRINK_UNT (32, 31), u32_i) :-: # 64-bit issue: These will become 64,63 on 64-bit implementations.
("testu_32_32", hbo::SHRINK_UNT (32, 32), u32_i32) :-: # 64-bit issue: These will become 64,64 on 64-bit implementations.
("copy_32_32_ii", hbo::COPY (32, 32), i32_i32) :-: # 64-bit issue: These will become 64,64 on 64-bit implementations.
("copy_32_32_ui", hbo::COPY (32, 32), u32_i32) :-: # 64-bit issue: These will become 64,64 on 64-bit implementations.
("copy_32_32_iu", hbo::COPY (32, 32), i32_u32) :-: # 64-bit issue: These will become 64,64 on 64-bit implementations.
("copy_32_32_uu", hbo::COPY (32, 32), u32_u32) :-: # 64-bit issue: These will become 64,64 on 64-bit implementations.
("copy_31_31_ii", hbo::COPY (31, 31), i_i) :-: # 64-bit issue: These will become 63,63 on 64-bit implementations.
("copy_31_31_ui", hbo::COPY (31, 31), u_i) :-: # 64-bit issue: These will become 63,63 on 64-bit implementations.
("copy_31_31_iu", hbo::COPY (31, 31), i_u) :-: # 64-bit issue: These will become 63,63 on 64-bit implementations.
("copy_31_32_i", hbo::COPY (31, 32), u_i32) :-: # 64-bit issue: These will become 63,64 on 64-bit implementations.
("copy_31_32_u", hbo::COPY (31, 32), u_u32) :-: # 64-bit issue: These will become 63,64 on 64-bit implementations.
("copy_8_32_i", hbo::COPY (8, 32), u8_i32) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("copy_8_32_u", hbo::COPY (8, 32), u8_u32) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("copy_8_31", hbo::COPY (8, 31), u8_i) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("extend_31_32_ii", hbo::STRETCH (31, 32), i_i32) :-: # 64-bit issue: These will become 63,64 on 64-bit implementations.
("extend_31_32_iu", hbo::STRETCH (31, 32), i_u32) :-: # 64-bit issue: These will become 63,64 on 64-bit implementations.
("extend_31_32_ui", hbo::STRETCH (31, 32), u_i32) :-: # 64-bit issue: These will become 63,64 on 64-bit implementations.
("extend_31_32_uu", hbo::STRETCH (31, 32), u_u32) :-: # 64-bit issue: These will become 63,64 on 64-bit implementations.
("extend_8_31", hbo::STRETCH (8, 31), u8_i) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("extend_8_32_i", hbo::STRETCH (8, 32), u8_i32) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("extend_8_32_u", hbo::STRETCH (8, 32), u8_u32) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("trunc_32_31_i", hbo::CHOP (32, 31), i32_u) :-: # 64-bit issue: These will become 64,63 on 64-bit implementations.
("trunc_32_31_u", hbo::CHOP (32, 31), u32_u) :-: # 64-bit issue: These will become 64,63 on 64-bit implementations.
("trunc_31_8", hbo::CHOP (31, 8), i_u8) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("trunc_32_8_i", hbo::CHOP (32, 8), i32_u8) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("trunc_32_8_u", hbo::CHOP (32, 8), u32_u8) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
# Conversion primops involving Integer
#
("test_i0_31", hbo::SHRINK_INTEGER 31, i0_i) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("test_i0_32", hbo::SHRINK_INTEGER 32, i0_i32) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("test_i0_64", hbo::SHRINK_INTEGER 64, i0_i64) :-: # 64-bit issue: Will this become 128 on 64-bit implementations?
#
("copy_8_inf", hbo::COPY_TO_INTEGER 8, u8_i0) :-:
("copy_8_i0_u", hbo::COPY_TO_INTEGER 8, u8_i0) :-: # Nowhere used.
("copy_31_i0_u", hbo::COPY_TO_INTEGER 31, u_i0) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("copy_32_i0_u", hbo::COPY_TO_INTEGER 32, u32_i0) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("copy_64_i0_u", hbo::COPY_TO_INTEGER 64, u64_i0) :-: # Nowhere used. # 64-bit issue: Will this become 128 on 64-bit implementations?
("copy_31_i0_i", hbo::COPY_TO_INTEGER 31, i_i0) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("copy_32_i0_i", hbo::COPY_TO_INTEGER 32, i32_i0) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("copy_64_i0_i", hbo::COPY_TO_INTEGER 64, i64_i0) :-: # 64-bit issue: Will this become 128 on 64-bit implementations?
#
("extend_8_inf", hbo::STRETCH_TO_INTEGER 8, u8_i0) :-:
("extend_8_i0_u", hbo::STRETCH_TO_INTEGER 8, u8_i0) :-: # Nowhere used.
("extend_31_i0_u", hbo::STRETCH_TO_INTEGER 31, u_i0) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("extend_32_i0_u", hbo::STRETCH_TO_INTEGER 32, u32_i0) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("extend_64_i0_u", hbo::STRETCH_TO_INTEGER 64, u64_i0) :-: # Nowhere used. # 64-bit issue: Will this become 128 on 64-bit implementations?
("extend_31_i0_i", hbo::STRETCH_TO_INTEGER 31, i_i0) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("extend_32_i0_i", hbo::STRETCH_TO_INTEGER 32, i32_i0) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("extend_64_i0_i", hbo::STRETCH_TO_INTEGER 64, i64_i0) :-: # 64-bit issue: Will this become 128 on 64-bit implementations?
#
("trunc_i0_8", hbo::CHOP_INTEGER 8, i0_u8) :-:
("trunc_i0_31", hbo::CHOP_INTEGER 31, i0_u) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("trunc_i0_32", hbo::CHOP_INTEGER 32, i0_u32) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("trunc_i0_64", hbo::CHOP_INTEGER 64, i0_u64) :-: # 64-bit issue: Will this become 128 on 64-bit implementations?
# Primops to go between abstract and concrete
# representations of 64-bit ints and words:
#
("u64p", hbo::CVT64, u64_pu32) :-:
("p64u", hbo::CVT64, pu32_u64) :-:
("i64p", hbo::CVT64, i64_pu32) :-:
("p64i", hbo::CVT64, pu32_i64) :-:
# Integer 31 primops.
# Many of the i31 primops are being abused for different types
# (mostly one_byte_unt::word and also for char). In these cases
# there are suffixed alternative versions of the baseop
# (i.e., same baseop, different type).
#
("ti1_add", tagged_int_op hbo::ADD, ii_i) :-: # "ti1_" == "one-word tagged int". This will have 31 bits of significance on 32-bit machines and 63 on 64-bit machines -- the tag takes one bit.
("ti1_add_8", tagged_int_op hbo::ADD, u8u8_u8) :-:
("ti1_subtract", tagged_int_op hbo::SUBTRACT, ii_i) :-:
("ti1_subtract_8", tagged_int_op hbo::SUBTRACT, u8u8_u8) :-:
("ti1_mul", tagged_int_op hbo::MULTIPLY, ii_i) :-:
("ti1_mul_8", tagged_int_op hbo::MULTIPLY, u8u8_u8) :-:
("ti1_div", tagged_int_op hbo::DIV, ii_i) :-: # NB: hbo::DIV does round-to-negative-infinity division -- this will be much slower on Intel32, has to be faked.
("ti1_div_8", tagged_int_op hbo::DIV, u8u8_u8) :-: # NB: hbo::DIV does round-to-negative-infinity division -- this will be much slower on Intel32, has to be faked.
("ti1_mod", tagged_int_op hbo::MOD, ii_i) :-: # NB: hbo::MOD does round-to-negative-infinity division -- this will be much slower on Intel32, has to be faked.
("ti1_mod_8", tagged_int_op hbo::MOD, u8u8_u8) :-: # NB: hbo::MOD does round-to-negative-infinity division -- this will be much slower on Intel32, has to be faked.
("ti1_quot", tagged_int_op hbo::DIVIDE, ii_i) :-: # NB: hbo::DIVIDE does round-to-zero division -- this is the native instruction on Intel32.
("ti1_rem", tagged_int_op hbo::REM, ii_i) :-: # NB: hbo::REM does round-to-zero division -- this is the native instruction on Intel32.
("ti1_bitwise_or", bits31_op hbo::BITWISE_OR, ii_i) :-:
("ti1_bitwise_or_8", bits31_op hbo::BITWISE_OR, u8u8_u8) :-:
("ti1_bitwise_and", bits31_op hbo::BITWISE_AND, ii_i) :-:
("ti1_bitwise_and_8",bits31_op hbo::BITWISE_AND, u8u8_u8) :-:
("ti1_bitwise_xor", bits31_op hbo::BITWISE_XOR, ii_i) :-:
("ti1_bitwise_xor_8",bits31_op hbo::BITWISE_XOR, u8u8_u8) :-:
("ti1_bitwise_not", bits31_op hbo::BITWISE_NOT, i_i) :-:
("ti1_bitwise_not_8",bits31_op hbo::BITWISE_NOT, u8_u8) :-:
("ti1_negate", tagged_int_op hbo::NEGATE, i_i) :-:
("ti1_negate_8", tagged_int_op hbo::NEGATE, u8_u8) :-:
("ti1_lshift", bits31_op hbo::LSHIFT, ii_i) :-:
("ti1_lshift_8", bits31_op hbo::LSHIFT, u8w_u8) :-:
("ti1_rshift", bits31_op hbo::RSHIFT, ii_i) :-:
("ti1_rshift_8", bits31_op hbo::RSHIFT, u8w_u8) :-:
("ti1_lt", tagged_intcmp_op hbo::LT, ii_b) :-:
("ti1_lt_8", tagged_intcmp_op hbo::LT, u8u8_b) :-:
("ti1_lt_c", tagged_intcmp_op hbo::LT, cc_b) :-:
("ti1_le", tagged_intcmp_op hbo::LE, ii_b) :-:
("ti1_le_8", tagged_intcmp_op hbo::LE, u8u8_b) :-:
("ti1_le_c", tagged_intcmp_op hbo::LE, cc_b) :-:
("ti1_gt", tagged_intcmp_op hbo::GT, ii_b) :-:
("ti1_gt_8", tagged_intcmp_op hbo::GT, u8u8_b) :-:
("ti1_gt_c", tagged_intcmp_op hbo::GT, cc_b) :-:
("ti1_ge", tagged_intcmp_op hbo::GE, ii_b) :-:
("ti1_ge_8", tagged_intcmp_op hbo::GE, u8u8_b) :-:
("ti1_ge_c", tagged_intcmp_op hbo::GE, cc_b) :-:
("ti1_ltu", tagged_unt_cmp_op hbo::LTU, ii_b) :-:
("ti1_geu", tagged_unt_cmp_op hbo::GEU, ii_b) :-:
("ti1_eq", tagged_intcmp_op hbo::EQL, ii_b) :-:
("ti1_ne", tagged_intcmp_op hbo::NEQ, ii_b) :-:
("ti1_min", hbo::MIN_MACRO (hbo::INT 31), ii_i) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("ti1_min_8", hbo::MIN_MACRO (hbo::INT 31), u8u8_u8) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("ti1_max", hbo::MAX_MACRO (hbo::INT 31), ii_i) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("ti1_max_8", hbo::MAX_MACRO (hbo::INT 31), u8u8_u8) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("ti1_abs", hbo::ABS_MACRO (hbo::INT 31), i_i) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
# Integer 32 primops.
#
("i1_mul", int1_op hbo::MULTIPLY, i32i32_i32) :-: # "i1_" == "one-word int". This will be 32 bits on 32-bit machines and 64 bits on 64-bit machines.
("i1_div", int1_op hbo::DIV, i32i32_i32) :-: # NB: hbo::DIV does round-to-negative-infinity division -- this will be much slower on Intel32, has to be faked.
("i1_mod", int1_op hbo::MOD, i32i32_i32) :-: # NB: hbo::MOD does round-to-negative-infinity division -- this will be much slower on Intel32, has to be faked.
("i1_quot", int1_op hbo::DIVIDE, i32i32_i32) :-: # NB: hbo::DIVIDE does round-to-zero division -- this is the native instruction on Intel32.
("i1_rem", int1_op hbo::REM, i32i32_i32) :-: # NB: hbo::REM does round-to-zero division -- this is the native instruction on Intel32.
("i1_add", int1_op hbo::ADD, i32i32_i32) :-:
("i1_subtract", int1_op hbo::SUBTRACT, i32i32_i32) :-:
("i1_bitwise_or", bits32_op hbo::BITWISE_OR, i32i32_i32) :-:
("i1_bitwise_and", bits32_op hbo::BITWISE_AND, i32i32_i32) :-:
("i1_bitwise_xor", bits32_op hbo::BITWISE_XOR, i32i32_i32) :-:
("i1_lshift", bits32_op hbo::LSHIFT, i32i32_i32) :-:
("i1_rshift", bits32_op hbo::RSHIFT, i32i32_i32) :-:
("i1_negate", int1_op hbo::NEGATE, i32_i32) :-:
("i1_lt", int1cmp_op hbo::LT, i32i32_b) :-:
("i1_le", int1cmp_op hbo::LE, i32i32_b) :-:
("i1_gt", int1cmp_op hbo::GT, i32i32_b) :-:
("i1_ge", int1cmp_op hbo::GE, i32i32_b) :-:
("i1_eq", int1cmp_op hbo::EQL, i32i32_b) :-:
("i1_ne", int1cmp_op hbo::NEQ, i32i32_b) :-:
("i1_min", hbo::MIN_MACRO (hbo::INT 32), i32i32_i32) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("i1_max", hbo::MAX_MACRO (hbo::INT 32), i32i32_i32) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("i1_abs", hbo::ABS_MACRO (hbo::INT 32), i32_i32) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
# Float 64 primops:
#
("f64_add", purefloat64_op hbo::ADD, f64f64_f64) :-: # "f64_" == "64-bit float". This will be 64 bits on both 32-bit and 64-bit machines.
("f64_subtract", purefloat64_op hbo::SUBTRACT, f64f64_f64) :-:
("f64_div", purefloat64_op hbo::DIVIDE, f64f64_f64) :-:
("f64_mul", purefloat64_op hbo::MULTIPLY, f64f64_f64) :-:
("f64_negate", purefloat64_op hbo::NEGATE, f64_f64) :-:
("f64_ge", float64cmp_op hbo::GE, f64f64_b) :-:
("f64_gt", float64cmp_op hbo::GT, f64f64_b) :-:
("f64_le", float64cmp_op hbo::LE, f64f64_b) :-:
("f64_lt", float64cmp_op hbo::LT, f64f64_b) :-:
("f64_eq", float64cmp_op hbo::EQL, f64f64_b) :-:
("f64_ne", float64cmp_op hbo::NEQ, f64f64_b) :-:
("f64_abs", purefloat64_op hbo::ABS, f64_f64) :-:
("f64_sin", purefloat64_op hbo::FSIN, f64_f64) :-:
("f64_cos", purefloat64_op hbo::FCOS, f64_f64) :-:
("f64_tan", purefloat64_op hbo::FTAN, f64_f64) :-:
("f64_sqrt", purefloat64_op hbo::FSQRT, f64_f64) :-:
("f64_min", hbo::MIN_MACRO (hbo::FLOAT 64), f64f64_f64) :-:
("f64_max", hbo::MAX_MACRO (hbo::FLOAT 64), f64f64_f64) :-:
# Float64 rw_vector:
#
("rw_f64_vector_get", rw_vector_get (hbo::FLOAT 64), num_vector_get_type) :-:
("rw_f64_vector_get_with_boundscheck", rw_vector_get_with_boundscheck (hbo::FLOAT 64), num_vector_get_type) :-:
("rw_f64_vector_set", rw_vector_set (hbo::FLOAT 64), num_vector_set_type) :-:
("rw_f64_vector_set_with_boundscheck", rw_vector_set_with_boundscheck (hbo::FLOAT 64), num_vector_set_type) :-:
# ** one_byte_unt primops **
# In the long run, we plan to represent WRAPPED one_byte_unt tagged, and
# UNWRAPPED untagged. But right now, we represent both of them
# tagged, with 23 high-order zero bits and 1 low-order 1 bit.
# In this representation, we can use the comparison and (some of
# the) bitwise operators of tagged_unt; but we cannot use the shift
# and arithmetic operators.
#
# WARNING: THIS IS A TEMPORARY HACKJOB until all the one_byte_unt primops
# are correctly implemented. XXX SUCKO FIXME
#
# ("u8_mul", unt8_op hbo::MULTIPLY, u8u8_u8) :-: # "u8_" == "eight-bit unsigned int". These will be the same size on 32-bit and 64-bit systems.
# ("u8_div", unt8_op hbo::DIVIDE, u8u8_u8) :-:
# ("u8_add", unt8_op hbo::ADD, u8u8_u8) :-:
# ("u8_subtract", unt8_op hbo::SUBTRACT, u8u8_u8) :-:
#
# ("u8_bitwise_not", tagged_unt_op hbo::BITWISE_NOT, u8_u8) :-:
# ("u8_rshift", unt8_op hbo::RSHIFT, u8w_u8) :-:
# ("u8_rshiftl", unt8_op hbo::RSHIFTL, u8w_u8) :-:
# ("u8_lshift", unt8_op hbo::LSHIFT, u8w_u8) :-:
#
# ("u8_toint", hbo::ROUND { floor=TRUE,
# from=hbo::UNT 8,
# to=hbo::INT 31 }, u8_i) :-:
# ("u8_fromint", hbo::REAL { from=hbo::INT 31,
# to=hbo::UNT 8 }, i_u8) :-:
("u8_bitwise_or", tagged_unt_op hbo::BITWISE_OR, u8u8_u8) :-:
("u8_bitwise_xor", tagged_unt_op hbo::BITWISE_XOR, u8u8_u8) :-:
("u8_bitwise_and", tagged_unt_op hbo::BITWISE_AND, u8u8_u8) :-:
("u8_gt", unt8cmp_op hbo::GT, u8u8_b) :-:
("u8_ge", unt8cmp_op hbo::GE, u8u8_b) :-:
("u8_lt", unt8cmp_op hbo::LT, u8u8_b) :-:
("u8_le", unt8cmp_op hbo::LE, u8u8_b) :-:
("u8_eq", unt8cmp_op hbo::EQL, u8u8_b) :-:
("u8_ne", unt8cmp_op hbo::NEQ, u8u8_b) :-:
# ** one_byte_unt rw_vector and vector **
#
("rw_unt8_vector_get", rw_vector_get (hbo::UNT 8), num_vector_get_type) :-: # Apparently none of these are used at present. -- 2013-11-20 CrT
("rw_unt8_vector_get_with_boundscheck", rw_vector_get_with_boundscheck (hbo::UNT 8), num_vector_get_type) :-:
("ro_unt8_vector_get", ro_vector_get (hbo::UNT 8), num_vector_get_type) :-:
("ro_unt8_vector_get_with_boundscheck", ro_vector_get_with_boundscheck (hbo::UNT 8), num_vector_get_type) :-:
("rw_unt8_vector_set", rw_vector_set (hbo::UNT 8), num_vector_set_type) :-:
("rw_unt8_vector_set_with_boundscheck", rw_vector_set_with_boundscheck (hbo::UNT 8), num_vector_set_type) :-:
# tagged_unt primops
#
("tu1_mul", tagged_unt_op hbo::MULTIPLY, uu_u) :-: # "tu1_" == "one-word tagged unt". This will have 31 bits of significance on 32-bit machines and 63 on 64-bit machines -- the tag takes one bit.
("tu1_div", tagged_unt_op hbo::DIVIDE, uu_u) :-: # NB: hbo::DIVIDE does round-to-zero division -- this is the native instruction on Intel32.
("tu1_mod", tagged_unt_op hbo::REM, uu_u) :-: # NB: hbo::REM does round-to-zero division -- this is the native instruction on Intel32.
("tu1_add", tagged_unt_op hbo::ADD, uu_u) :-:
("tu1_subtract", tagged_unt_op hbo::SUBTRACT, uu_u) :-:
("tu1_bitwise_or", tagged_unt_op hbo::BITWISE_OR, uu_u) :-:
("tu1_bitwise_xor", tagged_unt_op hbo::BITWISE_XOR, uu_u) :-:
("tu1_bitwise_and", tagged_unt_op hbo::BITWISE_AND, uu_u) :-:
("tu1_bitwise_not", tagged_unt_op hbo::BITWISE_NOT, u_u) :-:
("tu1_negate", tagged_unt_op hbo::NEGATE, u_u) :-:
("tu1_rshift", tagged_unt_op hbo::RSHIFT, uu_u) :-:
("tu1_rshiftl", tagged_unt_op hbo::RSHIFTL, uu_u) :-:
("tu1_lshift", tagged_unt_op hbo::LSHIFT, uu_u) :-:
#
("tu1_gt", tagged_unt_cmp_op hbo::GT, uu_b) :-:
("tu1_ge", tagged_unt_cmp_op hbo::GE, uu_b) :-:
("tu1_lt", tagged_unt_cmp_op hbo::LT, uu_b) :-:
("tu1_le", tagged_unt_cmp_op hbo::LE, uu_b) :-:
("tu1_eq", tagged_unt_cmp_op hbo::EQL, uu_b) :-:
("tu1_ne", tagged_unt_cmp_op hbo::NEQ, uu_b) :-:
("tu1_check_rshift", hbo::RSHIFT_MACRO (hbo::UNT 31), uu_u) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("tu1_check_rshiftl",hbo::RSHIFTL_MACRO (hbo::UNT 31), uu_u) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("tu1_check_lshift", hbo::LSHIFT_MACRO (hbo::UNT 31), uu_u) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("tu1_min", hbo::MIN_MACRO (hbo::UNT 31), uu_u) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("tu1_max", hbo::MAX_MACRO (hbo::UNT 31), uu_u) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
# (pseudo-)one_byte_unt primops
("tu1_mul_8", tagged_unt_op hbo::MULTIPLY, u8u8_u8) :-:
("tu1_div_8", tagged_unt_op hbo::DIVIDE, u8u8_u8) :-: # NB: hbo::DIVIDE does round-to-zero division -- this is the native instruction on Intel32.
("tu1_mod_8", tagged_unt_op hbo::REM, u8u8_u8) :-: # NB: hbo::REM does round-to-zero division -- this is the native instruction on Intel32.
("tu1_add_8", tagged_unt_op hbo::ADD, u8u8_u8) :-:
("tu1_subtract_8", tagged_unt_op hbo::SUBTRACT, u8u8_u8) :-:
("tu1_bitwise_or_8", tagged_unt_op hbo::BITWISE_OR, u8u8_u8) :-:
("tu1_bitwise_xor_8",tagged_unt_op hbo::BITWISE_XOR, u8u8_u8) :-:
("tu1_bitwise_and_8",tagged_unt_op hbo::BITWISE_AND, u8u8_u8) :-:
("tu1_bitwise_not_8",tagged_unt_op hbo::BITWISE_NOT, u8_u8) :-:
("tu1_negate_8", tagged_unt_op hbo::NEGATE, u8_u8) :-:
("tu1_rshift_8", tagged_unt_op hbo::RSHIFT, u8w_u8) :-:
("tu1_rshiftl_8", tagged_unt_op hbo::RSHIFTL, u8w_u8) :-:
("tu1_lshift_8", tagged_unt_op hbo::LSHIFT, u8w_u8) :-:
("tu1_gt_8", tagged_unt_cmp_op hbo::GT, u8u8_b) :-:
("tu1_ge_8", tagged_unt_cmp_op hbo::GE, u8u8_b) :-:
("tu1_lt_8", tagged_unt_cmp_op hbo::LT, u8u8_b) :-:
("tu1_le_8", tagged_unt_cmp_op hbo::LE, u8u8_b) :-:
("tu1_eq_8", tagged_unt_cmp_op hbo::EQL, u8u8_b) :-:
("tu1_ne_8", tagged_unt_cmp_op hbo::NEQ, u8u8_b) :-:
("tu1_check_rshift_8", hbo::RSHIFT_MACRO (hbo::UNT 31), u8w_u8) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("tu1_check_rshiftl_8", hbo::RSHIFTL_MACRO (hbo::UNT 31), u8w_u8) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("tu1_check_lshift_8", hbo::LSHIFT_MACRO (hbo::UNT 31), u8w_u8) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("tu1_min_8", hbo::MIN_MACRO (hbo::UNT 31), u8u8_u8) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("tu1_max_8", hbo::MAX_MACRO (hbo::UNT 31), u8u8_u8) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
# ** one_word_unt primops **
("u1_mul", unt1_op hbo::MULTIPLY, u32u32_u32) :-: # "u1_" == "one-word unsigned int". This will be 32 bits on 32-bit machines and 64 bits on 64-bit machines.
("u1_div", unt1_op hbo::DIVIDE, u32u32_u32) :-: # NB: hbo::DIVIDE does round-to-zero division -- this is the native instruction on Intel32.
("u1_mod", unt1_op hbo::REM, u32u32_u32) :-: # NB: hbo::REM does round-to-zero division -- this is the native instruction on Intel32.
("u1_add", unt1_op hbo::ADD, u32u32_u32) :-:
("u1_subtract", unt1_op hbo::SUBTRACT, u32u32_u32) :-:
("u1_bitwise_or", unt1_op hbo::BITWISE_OR, u32u32_u32) :-:
("u1_bitwise_xor", unt1_op hbo::BITWISE_XOR, u32u32_u32) :-:
("u1_bitwise_and", unt1_op hbo::BITWISE_AND, u32u32_u32) :-:
("u1_bitwise_not", unt1_op hbo::BITWISE_NOT, u32_u32) :-:
("u1_negate", unt1_op hbo::NEGATE, u32_u32) :-:
("u1_rshift", unt1_op hbo::RSHIFT, u32u_u32) :-:
("u1_rshiftl", unt1_op hbo::RSHIFTL, u32u_u32) :-:
("u1_lshift", unt1_op hbo::LSHIFT, u32u_u32) :-:
("u1_gt", unt1_cmp_op hbo::GT, u32u32_b) :-:
("u1_ge", unt1_cmp_op hbo::GE, u32u32_b) :-:
("u1_lt", unt1_cmp_op hbo::LT, u32u32_b) :-:
("u1_le", unt1_cmp_op hbo::LE, u32u32_b) :-:
("u1_eq", unt1_cmp_op hbo::EQL, u32u32_b) :-:
("u1_ne", unt1_cmp_op hbo::NEQ, u32u32_b) :-:
#
("u1_check_rshift", hbo::RSHIFT_MACRO (hbo::UNT 32), u32u_u32) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("u1_check_rshiftl",hbo::RSHIFTL_MACRO (hbo::UNT 32), u32u_u32) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("u1_check_lshift", hbo::LSHIFT_MACRO (hbo::UNT 32), u32u_u32) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("u1_min", hbo::MIN_MACRO (hbo::UNT 32), u32u32_u32) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("u1_max", hbo::MAX_MACRO (hbo::UNT 32), u32u32_u32) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
# Experimental C FFI baseops: # "FFI" == "Foriegn Function Interface" -- calling C directly from Mythryl.
#
("rawu8_get", hbo::GET_FROM_NONHEAP_RAM (hbo::UNT 8), u32_u32) :-:
("rawi8_get", hbo::GET_FROM_NONHEAP_RAM (hbo::INT 8), u32_i32) :-:
("raww16_get", hbo::GET_FROM_NONHEAP_RAM (hbo::UNT 16), u32_u32) :-:
("rawi16_get", hbo::GET_FROM_NONHEAP_RAM (hbo::INT 16), u32_i32) :-:
("rawu32_get", hbo::GET_FROM_NONHEAP_RAM (hbo::UNT 32), u32_u32) :-:
("rawi32_get", hbo::GET_FROM_NONHEAP_RAM (hbo::INT 32), u32_i32) :-:
("rawf32_get", hbo::GET_FROM_NONHEAP_RAM (hbo::FLOAT 32), u32_f64) :-:
("rawf64_get", hbo::GET_FROM_NONHEAP_RAM (hbo::FLOAT 64), u32_f64) :-:
("rawu8_set", hbo::SET_NONHEAP_RAM (hbo::UNT 8), u32u32_u) :-:
("rawi8_set", hbo::SET_NONHEAP_RAM (hbo::INT 8), u32i32_u) :-:
("raww16_set", hbo::SET_NONHEAP_RAM (hbo::UNT 16), u32u32_u) :-:
("rawi16_set", hbo::SET_NONHEAP_RAM (hbo::INT 16), u32i32_u) :-:
("rawu32_set", hbo::SET_NONHEAP_RAM (hbo::UNT 32), u32u32_u) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("rawi32_set", hbo::SET_NONHEAP_RAM (hbo::INT 32), u32i32_u) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("rawf32_set", hbo::SET_NONHEAP_RAM (hbo::FLOAT 32), u32f64_u) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("rawf64_set", hbo::SET_NONHEAP_RAM (hbo::FLOAT 64), u32f64_u) :-: # 64-bit issue: Will this become 128 on 64-bit implementations?
("rawccall", hbo::RAW_CCALL NULL, rcc_type) :-:
# Support for direct construction of C chunks on ML heap.
# rawrecord builds a record holding C chunks on the heap.
# rawselectxxx index on this record. They are of type:
# X * one_word_unt::word -> one_word_unt::word
# The X is to guarantee that the compiler will treat
# the record as a ML chunk, in case it passes thru a gc boundary.
# rawupdatexxx writes to the record.
("rawrecord", hbo::RAW_ALLOCATE_C_RECORD { fblock => FALSE }, i_x) :-:
("rawrecord64", hbo::RAW_ALLOCATE_C_RECORD { fblock => TRUE }, i_x) :-:
("rawselectu8", hbo::GET_FROM_NONHEAP_RAM (hbo::UNT 8), xu32_u32) :-:
("rawselecti8", hbo::GET_FROM_NONHEAP_RAM (hbo::INT 8), xu32_i32) :-:
("rawselectw16", hbo::GET_FROM_NONHEAP_RAM (hbo::UNT 16), xu32_u32) :-:
("rawselecti16", hbo::GET_FROM_NONHEAP_RAM (hbo::INT 16), xu32_i32) :-:
("rawselectu32", hbo::GET_FROM_NONHEAP_RAM (hbo::UNT 32), xu32_u32) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("rawselecti32", hbo::GET_FROM_NONHEAP_RAM (hbo::INT 32), xu32_i32) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("rawselectf32", hbo::GET_FROM_NONHEAP_RAM (hbo::FLOAT 32), xu32_f64) :-:
("rawselectf64", hbo::GET_FROM_NONHEAP_RAM (hbo::FLOAT 64), xu32_f64) :-:
("rawupdateu8", hbo::SET_NONHEAP_RAM (hbo::UNT 8), xu32u32_u) :-:
("rawupdatei8", hbo::SET_NONHEAP_RAM (hbo::INT 8), xu32i32_u) :-:
("rawupdateu16", hbo::SET_NONHEAP_RAM (hbo::UNT 16), xu32u32_u) :-:
("rawupdatei16", hbo::SET_NONHEAP_RAM (hbo::INT 16), xu32i32_u) :-:
("rawupdateu32", hbo::SET_NONHEAP_RAM (hbo::UNT 32), xu32u32_u) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("rawupdatei32", hbo::SET_NONHEAP_RAM (hbo::INT 32), xu32i32_u) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("rawupdatef32", hbo::SET_NONHEAP_RAM (hbo::FLOAT 32), xu32f64_u) :-:
("rawupdatef64", hbo::SET_NONHEAP_RAM (hbo::FLOAT 64), xu32f64_u); # all_primops
end; # stipulate
# ulist package
unrolled_list_package_record
=
{ ev = sta::make_static_stamp "uListVariable";
#
all_elements
=
[ ( sy::make_type_symbol "List",
mld::TYPE_IN_API
{
type => mtt::unrolled_list_type,
module_stamp => ev,
is_a_replica => FALSE,
scope => 0
}
),
make_constructor_element ("NIL", mtt::unrolled_list_nil_valcon),
make_constructor_element ("!", mtt::unrolled_list_cons_valcon)
];
all_symbols = map #1 all_elements;
api_record
=
{ stamp => sta::make_static_stamp "uListApi",
name => NULL,
closed => TRUE,
#
contains_generic => FALSE,
package_sharing => NIL,
#
symbols => all_symbols,
api_elements => all_elements,
type_sharing => NIL,
#
property_list=> property_list::make_property_list (),
stub => NULL
};
ppl::set_api_bound_generic_evaluation_paths
( api_record,
THE []
);
mld::A_PACKAGE
{
an_api => mld::API api_record,
varhome => vh::null_varhome,
inlining_data => ij::make_inlining_data_list [],
#
typechecked_package => { stamp => sta::make_static_stamp "uListPackage",
stub => NULL,
#
typerstore => tro::set (tro::empty, ev, mld::TYPE_ENTRY mtt::unrolled_list_type),
property_list => property_list::make_property_list (),
inverse_path => ip::INVERSE_PATH [sy::make_package_symbol "uList"]
}
};
}; # unrolled_list_package_record
# 'inline' package:
#
inline_package_record
=
{ bottom = tdt::TYPESCHEME_TYPOID
{
typescheme_eqflags => [FALSE],
typescheme => tdt::TYPESCHEME { arity=>1, body=>tdt::TYPESCHEME_ARG 0 }
};
fun make_variable_element ((name, baseop, typoid), (symbols, elements, dacc, offset))
=
{ s = sy::make_value_symbol name;
sp = mld::VALUE_IN_API { typoid, slot=>offset };
d = ij::make_baseop_inlining_data (baseop, typoid);
( s ! symbols,
(s, sp) ! elements,
d ! dacc,
offset+1
);
};
(fold_forward make_variable_element ([],[],[], 0) all_primops)
->
(all_symbols, all_elements, inlining_data, _);
all_symbols = reverse all_symbols;
all_elements = reverse all_elements;
inlining_data = reverse inlining_data;
api_record
=
{ stamp => sta::make_static_stamp "Inline_Api",
name => NULL,
closed => TRUE,
#
contains_generic => FALSE,
#
symbols => all_symbols,
api_elements => all_elements,
#
type_sharing => NIL,
package_sharing => NIL,
#
property_list => property_list::make_property_list (),
stub => NULL
};
ppl::set_api_bound_generic_evaluation_paths
( api_record,
THE []
);
mld::A_PACKAGE
{
an_api => mld::API api_record,
varhome => vh::null_varhome,
inlining_data => ij::make_inlining_data_list inlining_data,
#
typechecked_package
=>
{ stamp => sta::make_static_stamp "inline_package",
stub => NULL,
typerstore => tro::empty,
#
property_list => property_list::make_property_list (),
inverse_path => ip::INVERSE_PATH [ sy::make_package_symbol "inline" ]
}
};
}; # inline_package_record
# Priming packages: base_types and inline:
#
stipulate
base_types_package_symbol = sy::make_package_symbol "base_types";
unrolled_list_package_symbol = sy::make_package_symbol "unrolled_list";
inline_package_symbol = sy::make_package_symbol "inline";
herein
base_types_and_ops_symbolmapstack
=
syx::bind (
inline_package_symbol,
sxe::NAMED_PACKAGE inline_package_record,
syx::bind (
unrolled_list_package_symbol,
sxe::NAMED_PACKAGE unrolled_list_package_record,
syx::bind (
base_types_package_symbol,
sxe::NAMED_PACKAGE base_types_package_record,
mj::include_package (syx::empty, base_types_package_record)
)
)
);
end;
base_types_and_ops_symbolmapstack
=
{ my { picklehash, pickle, ... }
=
pkj::pickle_symbolmapstack
#
(pkj::INITIAL_PICKLING stx::empty_stampmapstack)
#
base_types_and_ops_symbolmapstack;
unpickler_junk::unpickle_symbolmapstack # This will fill in modtree entries per src/lib/compiler/front/typer-stuff/modules/module-level-declarations.pkg #
(\\ _ = stx::empty_stampmapstack)
#
(picklehash, pickle);
};
}; # package base_types_and_ops
end; # stipulate