## base-types-and-ops-symbolmapstack.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_symbolmapstack 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_Symbolmapstack {
#
base_types_and_ops_symbolmapstack: symbolmapstack::Symbolmapstack;
};
stipulate
package err = error_message; # error_message is form 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 tt = type_types; # type_types is from src/lib/compiler/front/typer/types/type-types.pkg package ty = types; # types is from src/lib/compiler/front/typer-stuff/types/types.pkg package vh = varhome; # varhome is from src/lib/compiler/front/typer-stuff/basics/varhome.pkgherein
package base_types_and_ops_symbolmapstack
: (weak) Base_Types_And_Ops_Symbolmapstack # Base_Types_And_Ops_Symbolmapstack is from src/lib/compiler/front/semantic/symbolmapstack/base-types-and-ops-symbolmapstack.pkg {
# Note: this function only applies to constructors but not exceptions;
# exceptions will have a non-trivial slot number
fun make_constructor_element (name, datatype)
=
( sy::make_value_symbol name,
#
mld::VALCON_IN_API { datatype, 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:
#
# typ
#
# refers to the Typ (vs Type) type defined in
#
# src/lib/compiler/front/typer-stuff/types/types.pkg #
prim_typs # "prim" == "primitive", in the sense of "no substructure", not "unsophisticated".
=
[] :-:
("Bool", tt::bool_typ ) :-:
("List", tt::list_typ ) :-:
#
("Ref", tt::ref_typ ) :-:
("Void", tt::void_typ ) :-:
#
("Int", tt::int_typ ) :-:
("Int1", tt::int1_typ ) :-:
("Int2", tt::int2_typ ) :-:
("Multiword_Int", tt::multiword_int_typ ) :-:
#
("Float", tt::float64_typ ) :-:
#
("Unt", tt::unt_typ ) :-:
("Unt8", tt::unt8_typ ) :-:
("Unt1", tt::unt1_typ ) :-:
("Unt2", tt::unt2_typ ) :-:
#
("Fate", tt::fate_typ ) :-:
("Control_Fate", tt::control_fate_typ ) :-:
#
("Rw_Vector", tt::rw_vector_typ ) :-:
("Vector", tt::vector_typ ) :-:
("Unt8_Rw_Vector", tt::un8_rw_vector_typ ) :-:
("Float64_Rw_Vector", tt::float64_rw_vector_typ ) :-:
#
("Chunk", tt::chunk_typ ) :-:
("Cfunction", tt::c_function_typ ) :-:
#
("String", tt::string_typ ) :-:
("Char", tt::char_typ ) :-:
#
("Exception", tt::exception_typ ) :-:
#
("Spin_Lock", tt::spinlock_typ ) :-:
("Fragment", tt::frag_typ ) :-:
("Suspension", tt::susp_typ )
;
prim_cons
=
[] :-:
("TRUE", tt::true_dcon ) :-:
("FALSE", tt::false_dcon ) :-:
("!", tt::cons_dcon ) :-:
#
("NIL", tt::nil_dcon ) :-:
("REF", tt::ref_dcon ) :-:
#
("QUOTE", tt::quotedcon ) :-:
("ANTIQUOTE", tt::antiquotedcon ) :-:
("@@@", tt::dollar_dcon )
;
# 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_typ_element prim_typs
where
fun make_typ_element (name: String, typ)
=
( sy::make_type_symbol name,
#
mld::TYP_IN_API
{
typ,
module_stamp => sta::make_stale_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::TYP_IN_API { typ, module_stamp, is_a_replica, scope } ), r)
=>
tro::set (r, module_stamp, mld::TYP_ENTRY typ);
f _ => err::impossible "primTypes: typerstore";
end;
end;
typerstore
=
typerstore::mark (fn _ = sta::make_stale_stamp"primMacroExpansionDict", typerstore);
api_record
=
{ stamp => sta::make_stale_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_package_inlining_data [],
#
typechecked_package => { stamp => sta::make_stale_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::MATH { op, overflow=>FALSE, kindbits=>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::MATH { op, overflow=>TRUE, kindbits=>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::MATH { op, overflow=>FALSE, kindbits=>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::MATH { op, overflow=>FALSE, kindbits=>hbo::FLOAT size };
herein
purefloat64_op = purefloat_op 64;
end;
stipulate
fun cmp_op kindbits op = hbo::CMP { op, kindbits };
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.
unt1cmp_op = cmp_op (hbo::UNT 32); # 64-bit issue: This will become 64 on 64-bit implementations.
tagged_untcmp_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 = ty::TYPE_SCHEME_ARG_I 0;
arg1 = ty::TYPE_SCHEME_ARG_I 1;
arg2 = ty::TYPE_SCHEME_ARG_I 2;
tuple = tt::tuple_type;
fun arrow (t1, t2) = tt::(-->) (t1, t2);
fun ap (tc, l) = ty::TYPCON_TYPE (tc, l);
fun count t = ty::TYPCON_TYPE (tt::fate_typ, [t]);
fun ccnt t = ty::TYPCON_TYPE (tt::control_fate_typ, [t]);
fun rf t = ty::TYPCON_TYPE (tt::ref_typ, [t]);
fun rw_vector t = ty::TYPCON_TYPE (tt::rw_vector_typ, [t]);
fun vct t = ty::TYPCON_TYPE (tt::vector_typ, [t]);
void = tt::void_type;
bool = tt::bool_type;
int = tt::int_type;
i32 = tt::int1_type;
i64 = tt::int2_type;
multiword_int = tt::multiword_int_type;
u8 = tt::unt8_type;
unt = tt::unt_type;
u32 = tt::unt1_type;
u64 = tt::unt2_type;
f64 = tt::float64_type;
string = tt::string_type;
fun p0 t = t;
fun p1 t
=
ty::TYPE_SCHEME_TYPE { type_scheme_arg_eq_properties => [FALSE], type_scheme=>ty::TYPE_SCHEME { arity=>1, body=>t }};
fun ep1 t
=
ty::TYPE_SCHEME_TYPE { type_scheme_arg_eq_properties => [TRUE], type_scheme=>ty::TYPE_SCHEME { arity=>1, body=>t }};
fun p2 t
=
ty::TYPE_SCHEME_TYPE { type_scheme_arg_eq_properties => [FALSE, FALSE], type_scheme=>ty::TYPE_SCHEME { arity=>2, body=>t }};
fun p3 t
=
ty::TYPE_SCHEME_TYPE { type_scheme_arg_eq_properties => [FALSE, FALSE, FALSE], type_scheme=>ty::TYPE_SCHEME { arity=>3, body=>t }};
fun sub kindbits = hbo::GET_VECSLOT_NUMERIC_CONTENTS { kindbits, checked=>FALSE, immutable=>FALSE };
fun check_sub kindbits = hbo::GET_VECSLOT_NUMERIC_CONTENTS { kindbits, checked=>TRUE, immutable=>FALSE };
fun subv kindbits = hbo::GET_VECSLOT_NUMERIC_CONTENTS { kindbits, checked=>FALSE, immutable=>TRUE };
fun check_subv kindbits = hbo::GET_VECSLOT_NUMERIC_CONTENTS { kindbits, checked=>TRUE, immutable=>TRUE };
fun update kindbits = hbo::SET_VECSLOT_TO_NUMERIC_VALUE { kindbits, checked=>FALSE };
fun check_update kindbits = hbo::SET_VECSLOT_TO_NUMERIC_VALUE { kindbits, checked=>TRUE };
num_sub_type = p2 (arrow (tuple [arg0, int], arg1));
num_upd_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 tt::char_type;
# 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)
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_thread_register", hbo::GET_CURRENT_THREAD_REGISTER, p1 (arrow (void, arg0))) :-:
("set_current_thread_register", hbo::SET_CURRENT_THREAD_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)))) :-:
("before", hbo::BEFORE_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))) :-:
("inlnot", hbo::NOT_MACRO, b_b) :-:
("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.
("ordof", hbo::GET_VECSLOT_NUMERIC_CONTENTS { kindbits=>hbo::INT 8, checked=>FALSE, immutable=>TRUE }, num_sub_type) :-: # fetch-from-immutable vector_of_one_byte_unts::get (rw_)vector_of_chars::get
("store", hbo::SET_VECSLOT_TO_NUMERIC_VALUE { kindbits=>hbo::INT 8, checked=>FALSE }, num_upd_type) :-: # rw_vector_of_one_byte_unts::set
("inlbyteof", hbo::GET_VECSLOT_NUMERIC_CONTENTS { kindbits=>hbo::INT 8, checked=>TRUE, immutable=>FALSE }, num_sub_type) :-: # rw_vector_of_one_byte_unts::check_sub
("inlstore", hbo::SET_VECSLOT_TO_NUMERIC_VALUE { kindbits=>hbo::INT 8, checked=>TRUE }, num_upd_type) :-: # rw_vector_of_one_byte_unts::check_set
("inlordof", hbo::GET_VECSLOT_NUMERIC_CONTENTS { kindbits=>hbo::INT 8, checked=>TRUE, immutable=>TRUE }, num_sub_type) :-: # vector_of_one_byte_unts::check_sub (rw_)vector_of_chars::check_sub
# Type-agnostic rw_vector and vector:
#
("make_rw_vector", hbo::MAKE_RW_VECTOR_MACRO, p1 (arrow (tuple [int, arg0], rw_vector (arg0)))) :-:
#
("rw_vec_get", hbo::GET_RW_VECSLOT_CONTENTS, p1 (arrow (tuple [rw_vector (arg0), int], arg0))) :-:
("vec_get", hbo::GET_RO_VECSLOT_CONTENTS, p1 (arrow (tuple [vct (arg0), int], arg0))) :-:
("rw_vec_set", hbo::SET_VECSLOT, p1 (arrow (tuple [rw_vector (arg0), int, arg0], void))) :-:
#
("safe_rw_vec_get", hbo::GET_RW_VECSLOT_CONTENTS_AFTER_BOUNDS_CHECK, p1 (arrow (tuple [rw_vector (arg0), int], arg0))) :-:
("safe_vec_get", hbo::GET_RO_VECSLOT_CONTENTS_AFTER_BOUNDS_CHECK, p1 (arrow (tuple [vct (arg0), int], arg0))) :-:
("safe_rw_vec_set", hbo::SET_VECSLOT_AFTER_BOUNDS_CHECK, p1 (arrow (tuple [rw_vector (arg0), int, arg0], void))) :-:
# New rw_vector representations:
#
("new_array0", hbo::MAKE_ZERO_LENGTH_VECTOR, p1 (arrow (void, arg0))) :-:
("get_seq_data", hbo::GET_VECTOR_DATACHUNK, p2 (arrow (arg0, arg1))) :-:
("record_get", hbo::GET_RECSLOT_CONTENTS, p2 (arrow (tuple [arg0, int], arg1))) :-:
("raw64_get", hbo::GET_RAW64SLOT_CONTENTS, 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).
#
("i31add", tagged_int_op hbo::ADD, ii_i) :-:
("i31add_8", tagged_int_op hbo::ADD, u8u8_u8) :-:
("i31sub", tagged_int_op hbo::SUBTRACT, ii_i) :-:
("i31sub_8", tagged_int_op hbo::SUBTRACT, u8u8_u8) :-:
("i31mul", tagged_int_op hbo::MULTIPLY, ii_i) :-:
("i31mul_8", tagged_int_op hbo::MULTIPLY, u8u8_u8) :-:
("i31div", 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.
("i31div_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.
("i31mod", 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.
("i31mod_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.
("i31quot", tagged_int_op hbo::DIVIDE, ii_i) :-: # NB: hbo::DIVIDE does round-to-zero division -- this is the native instruction on Intel32.
("i31rem", tagged_int_op hbo::REM, ii_i) :-: # NB: hbo::REM does round-to-zero division -- this is the native instruction on Intel32.
("i31orb", bits31_op hbo::BITWISE_OR, ii_i) :-:
("i31orb_8", bits31_op hbo::BITWISE_OR, u8u8_u8) :-:
("i31andb", bits31_op hbo::BITWISE_AND, ii_i) :-:
("i31andb_8", bits31_op hbo::BITWISE_AND, u8u8_u8) :-:
("i31xorb", bits31_op hbo::BITWISE_XOR, ii_i) :-:
("i31xorb_8", bits31_op hbo::BITWISE_XOR, u8u8_u8) :-:
("i31notb", bits31_op hbo::BITWISE_NOT, i_i) :-:
("i31notb_8", bits31_op hbo::BITWISE_NOT, u8_u8) :-:
("i31neg", tagged_int_op hbo::NEGATE, i_i) :-:
("i31neg_8", tagged_int_op hbo::NEGATE, u8_u8) :-:
("i31lshift", bits31_op hbo::LSHIFT, ii_i) :-:
("i31lshift_8", bits31_op hbo::LSHIFT, u8w_u8) :-:
("i31rshift", bits31_op hbo::RSHIFT, ii_i) :-:
("i31rshift_8", bits31_op hbo::RSHIFT, u8w_u8) :-:
("i31lt", tagged_intcmp_op hbo::LT, ii_b) :-:
("i31lt_8", tagged_intcmp_op hbo::LT, u8u8_b) :-:
("i31lt_c", tagged_intcmp_op hbo::LT, cc_b) :-:
("i31le", tagged_intcmp_op hbo::LE, ii_b) :-:
("i31le_8", tagged_intcmp_op hbo::LE, u8u8_b) :-:
("i31le_c", tagged_intcmp_op hbo::LE, cc_b) :-:
("i31gt", tagged_intcmp_op hbo::GT, ii_b) :-:
("i31gt_8", tagged_intcmp_op hbo::GT, u8u8_b) :-:
("i31gt_c", tagged_intcmp_op hbo::GT, cc_b) :-:
("i31ge", tagged_intcmp_op hbo::GE, ii_b) :-:
("i31ge_8", tagged_intcmp_op hbo::GE, u8u8_b) :-:
("i31ge_c", tagged_intcmp_op hbo::GE, cc_b) :-:
("i31ltu", tagged_untcmp_op hbo::LTU, ii_b) :-:
("i31geu", tagged_untcmp_op hbo::GEU, ii_b) :-:
("i31eq", tagged_intcmp_op hbo::EQL, ii_b) :-:
("i31ne", tagged_intcmp_op hbo::NEQ, ii_b) :-:
("i31min", hbo::MIN_MACRO (hbo::INT 31), ii_i) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("i31min_8", hbo::MIN_MACRO (hbo::INT 31), u8u8_u8) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("i31max", hbo::MAX_MACRO (hbo::INT 31), ii_i) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("i31max_8", hbo::MAX_MACRO (hbo::INT 31), u8u8_u8) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("i31abs", hbo::ABS_MACRO (hbo::INT 31), i_i) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
# Integer 32 primops.
#
("i32mul", int1_op hbo::MULTIPLY, i32i32_i32) :-:
("i32div", 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.
("i32mod", 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.
("i32quot", int1_op hbo::DIVIDE, i32i32_i32) :-: # NB: hbo::DIVIDE does round-to-zero division -- this is the native instruction on Intel32.
("i32rem", int1_op hbo::REM, i32i32_i32) :-: # NB: hbo::REM does round-to-zero division -- this is the native instruction on Intel32.
("i32add", int1_op hbo::ADD, i32i32_i32) :-:
("i32sub", int1_op hbo::SUBTRACT, i32i32_i32) :-:
("i32orb", bits32_op hbo::BITWISE_OR, i32i32_i32) :-:
("i32andb", bits32_op hbo::BITWISE_AND, i32i32_i32) :-:
("i32xorb", bits32_op hbo::BITWISE_XOR, i32i32_i32) :-:
("i32lshift", bits32_op hbo::LSHIFT, i32i32_i32) :-:
("i32rshift", bits32_op hbo::RSHIFT, i32i32_i32) :-:
("i32neg", int1_op hbo::NEGATE, i32_i32) :-:
("i32lt", int1cmp_op hbo::LT, i32i32_b) :-:
("i32le", int1cmp_op hbo::LE, i32i32_b) :-:
("i32gt", int1cmp_op hbo::GT, i32i32_b) :-:
("i32ge", int1cmp_op hbo::GE, i32i32_b) :-:
("i32eq", int1cmp_op hbo::EQL, i32i32_b) :-:
("i32ne", int1cmp_op hbo::NEQ, i32i32_b) :-:
("i32min", hbo::MIN_MACRO (hbo::INT 32), i32i32_i32) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("i32max", hbo::MAX_MACRO (hbo::INT 32), i32i32_i32) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("i32abs", hbo::ABS_MACRO (hbo::INT 32), i32_i32) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
# Float 64 primops:
#
("f64add", purefloat64_op hbo::ADD, f64f64_f64) :-:
("f64sub", purefloat64_op hbo::SUBTRACT, f64f64_f64) :-:
("f64div", purefloat64_op hbo::DIVIDE, f64f64_f64) :-:
("f64mul", purefloat64_op hbo::MULTIPLY, f64f64_f64) :-:
("f64neg", purefloat64_op hbo::NEGATE, f64_f64) :-:
("f64ge", float64cmp_op hbo::GE, f64f64_b) :-:
("f64gt", float64cmp_op hbo::GT, f64f64_b) :-:
("f64le", float64cmp_op hbo::LE, f64f64_b) :-:
("f64lt", float64cmp_op hbo::LT, f64f64_b) :-:
("f64eq", float64cmp_op hbo::EQL, f64f64_b) :-:
("f64ne", float64cmp_op hbo::NEQ, f64f64_b) :-:
("f64abs", purefloat64_op hbo::ABS, f64_f64) :-:
("f64sin", purefloat64_op hbo::FSIN, f64_f64) :-:
("f64cos", purefloat64_op hbo::FCOS, f64_f64) :-:
("f64tan", purefloat64_op hbo::FTAN, f64_f64) :-:
("f64sqrt", purefloat64_op hbo::FSQRT, f64_f64) :-:
("f64min", hbo::MIN_MACRO (hbo::FLOAT 64), f64f64_f64) :-:
("f64max", hbo::MAX_MACRO (hbo::FLOAT 64), f64f64_f64) :-:
# Float64 rw_vector:
#
("f64_sub", sub (hbo::FLOAT 64), num_sub_type) :-:
("f64chk_sub", check_sub (hbo::FLOAT 64), num_sub_type) :-:
("f64_update", update (hbo::FLOAT 64), num_upd_type) :-:
("f64chk_update", check_update (hbo::FLOAT 64), num_upd_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 BUGGO FIXME
#
# ("u8mul", unt8_op (hbo::MULTIPLY), u8u8_u8) :-:
# ("u8div", unt8_op (hbo::DIVIDE), u8u8_u8) :-:
# ("u8add", unt8_op (hbo::ADD ), u8u8_u8) :-:
# ("u8sub", unt8_op (hbo::SUBTRACT ), u8u8_u8) :-:
#
# ("u8notb", tagged_unt_op hbo::BITWISE_NOT, u8_u8) :-:
# ("u8rshift", unt8_op hbo::RSHIFT, u8w_u8) :-:
# ("u8rshiftl", unt8_op hbo::RSHIFTL, u8w_u8) :-:
# ("u8lshift", unt8_op hbo::LSHIFT, u8w_u8) :-:
#
# ("u8toint", hbo::ROUND { floor=TRUE,
# from=hbo::UNT 8,
# to=hbo::INT 31 }, u8_i) :-:
# ("u8fromint", hbo::REAL { from=hbo::INT 31,
# to=hbo::UNT 8 }, i_u8) :-:
("u8orb", tagged_unt_op hbo::BITWISE_OR, u8u8_u8) :-:
("u8xorb", tagged_unt_op hbo::BITWISE_XOR, u8u8_u8) :-:
("u8andb", tagged_unt_op hbo::BITWISE_AND, u8u8_u8) :-:
("u8gt", unt8cmp_op hbo::GT, u8u8_b) :-:
("u8ge", unt8cmp_op hbo::GE, u8u8_b) :-:
("u8lt", unt8cmp_op hbo::LT, u8u8_b) :-:
("u8le", unt8cmp_op hbo::LE, u8u8_b) :-:
("u8eq", unt8cmp_op hbo::EQL, u8u8_b) :-:
("u8ne", unt8cmp_op hbo::NEQ, u8u8_b) :-:
# ** one_byte_unt rw_vector and vector **
("u8_sub", sub (hbo::UNT 8), num_sub_type) :-:
("u8chk_sub", check_sub (hbo::UNT 8), num_sub_type) :-:
("u8subv", subv (hbo::UNT 8), num_sub_type) :-:
("u8chk_subv", check_subv (hbo::UNT 8), num_sub_type) :-:
("u8update", update (hbo::UNT 8), num_upd_type) :-:
("u8chk_update", check_update (hbo::UNT 8), num_upd_type) :-:
# tagged_unt primops
("u31mul", tagged_unt_op (hbo::MULTIPLY), uu_u) :-:
("u31div", tagged_unt_op (hbo::DIVIDE), uu_u) :-: # NB: hbo::DIVIDE does round-to-zero division -- this is the native instruction on Intel32.
("u31mod", tagged_unt_op (hbo::REM), uu_u) :-: # NB: hbo::REM does round-to-zero division -- this is the native instruction on Intel32.
("u31add", tagged_unt_op (hbo::ADD ), uu_u) :-:
("u31sub", tagged_unt_op (hbo::SUBTRACT ), uu_u) :-:
("u31orb", tagged_unt_op hbo::BITWISE_OR, uu_u) :-:
("u31xorb", tagged_unt_op hbo::BITWISE_XOR, uu_u) :-:
("u31andb", tagged_unt_op hbo::BITWISE_AND, uu_u) :-:
("u31notb", tagged_unt_op hbo::BITWISE_NOT, u_u) :-:
("u31neg", tagged_unt_op hbo::NEGATE, u_u) :-:
("u31rshift", tagged_unt_op hbo::RSHIFT, uu_u) :-:
("u31rshiftl", tagged_unt_op hbo::RSHIFTL, uu_u) :-:
("u31lshift", tagged_unt_op hbo::LSHIFT, uu_u) :-:
("u31gt", tagged_untcmp_op (hbo::GT), uu_b) :-:
("u31ge", tagged_untcmp_op (hbo::GE), uu_b) :-:
("u31lt", tagged_untcmp_op (hbo::LT), uu_b) :-:
("u31le", tagged_untcmp_op (hbo::LE), uu_b) :-:
("u31eq", tagged_untcmp_op hbo::EQL, uu_b) :-:
("u31ne", tagged_untcmp_op hbo::NEQ, uu_b) :-:
("u31_check_rshift", hbo::RSHIFT_MACRO (hbo::UNT 31), uu_u) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("u31_check_rshiftl",hbo::RSHIFTL_MACRO (hbo::UNT 31), uu_u) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("u31_check_lshift", hbo::LSHIFT_MACRO (hbo::UNT 31), uu_u) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("u31min", hbo::MIN_MACRO (hbo::UNT 31), uu_u) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("u31max", hbo::MAX_MACRO (hbo::UNT 31), uu_u) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
# (pseudo-)one_byte_unt primops
("u31mul_8", tagged_unt_op (hbo::MULTIPLY), u8u8_u8) :-:
("u31div_8", tagged_unt_op (hbo::DIVIDE), u8u8_u8) :-: # NB: hbo::DIVIDE does round-to-zero division -- this is the native instruction on Intel32.
("u31mod_8", tagged_unt_op (hbo::REM), u8u8_u8) :-: # NB: hbo::REM does round-to-zero division -- this is the native instruction on Intel32.
("u31add_8", tagged_unt_op (hbo::ADD ), u8u8_u8) :-:
("u31sub_8", tagged_unt_op (hbo::SUBTRACT ), u8u8_u8) :-:
("u31orb_8", tagged_unt_op hbo::BITWISE_OR, u8u8_u8) :-:
("u31xorb_8", tagged_unt_op hbo::BITWISE_XOR, u8u8_u8) :-:
("u31andb_8", tagged_unt_op hbo::BITWISE_AND, u8u8_u8) :-:
("u31notb_8", tagged_unt_op hbo::BITWISE_NOT, u8_u8) :-:
("u31neg_8", tagged_unt_op hbo::NEGATE, u8_u8) :-:
("u31rshift_8", tagged_unt_op hbo::RSHIFT, u8w_u8) :-:
("u31rshiftl_8", tagged_unt_op hbo::RSHIFTL, u8w_u8) :-:
("u31lshift_8", tagged_unt_op hbo::LSHIFT, u8w_u8) :-:
("u31gt_8", tagged_untcmp_op (hbo::GT), u8u8_b) :-:
("u31ge_8", tagged_untcmp_op (hbo::GE), u8u8_b) :-:
("u31lt_8", tagged_untcmp_op (hbo::LT), u8u8_b) :-:
("u31le_8", tagged_untcmp_op (hbo::LE), u8u8_b) :-:
("u31eq_8", tagged_untcmp_op hbo::EQL, u8u8_b) :-:
("u31ne_8", tagged_untcmp_op hbo::NEQ, u8u8_b) :-:
("u31_check_rshift_8", hbo::RSHIFT_MACRO (hbo::UNT 31), u8w_u8) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("u31_check_rshiftl_8", hbo::RSHIFTL_MACRO (hbo::UNT 31), u8w_u8) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("u31_check_lshift_8", hbo::LSHIFT_MACRO (hbo::UNT 31), u8w_u8) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("u31min_8", hbo::MIN_MACRO (hbo::UNT 31), u8u8_u8) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
("u31max_8", hbo::MAX_MACRO (hbo::UNT 31), u8u8_u8) :-: # 64-bit issue: This will become 63 on 64-bit implementations.
# ** one_word_unt primops **
("u32mul", unt1_op (hbo::MULTIPLY), u32u32_u32) :-:
("u32div", unt1_op (hbo::DIVIDE), u32u32_u32) :-: # NB: hbo::DIVIDE does round-to-zero division -- this is the native instruction on Intel32.
("u32mod", unt1_op (hbo::REM), u32u32_u32) :-: # NB: hbo::REM does round-to-zero division -- this is the native instruction on Intel32.
("u32add", unt1_op (hbo::ADD ), u32u32_u32) :-:
("u32sub", unt1_op (hbo::SUBTRACT ), u32u32_u32) :-:
("u32orb", unt1_op hbo::BITWISE_OR, u32u32_u32) :-:
("u32xorb", unt1_op hbo::BITWISE_XOR, u32u32_u32) :-:
("u32andb", unt1_op hbo::BITWISE_AND, u32u32_u32) :-:
("u32notb", unt1_op hbo::BITWISE_NOT, u32_u32) :-:
("u32neg", unt1_op hbo::NEGATE, u32_u32) :-:
("u32rshift", unt1_op hbo::RSHIFT, u32u_u32) :-:
("u32rshiftl", unt1_op hbo::RSHIFTL, u32u_u32) :-:
("u32lshift", unt1_op hbo::LSHIFT, u32u_u32) :-:
("u32gt", unt1cmp_op (hbo::GT), u32u32_b) :-:
("u32ge", unt1cmp_op (hbo::GE), u32u32_b) :-:
("u32lt", unt1cmp_op (hbo::LT), u32u32_b) :-:
("u32le", unt1cmp_op (hbo::LE), u32u32_b) :-:
("u32eq", unt1cmp_op hbo::EQL, u32u32_b) :-:
("u32ne", unt1cmp_op hbo::NEQ, u32u32_b) :-:
#
("u32_check_rshift", hbo::RSHIFT_MACRO (hbo::UNT 32), u32u_u32) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("u32_check_rshiftl",hbo::RSHIFTL_MACRO (hbo::UNT 32), u32u_u32) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("u32_check_lshift", hbo::LSHIFT_MACRO (hbo::UNT 32), u32u_u32) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("u32min", hbo::MIN_MACRO (hbo::UNT 32), u32u32_u32) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("u32max", hbo::MAX_MACRO (hbo::UNT 32), u32u32_u32) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
# experimental C FFI primops
("rawu8l", hbo::GET_FROM_NONHEAP_RAM (hbo::UNT 8), u32_u32) :-:
("rawi8l", hbo::GET_FROM_NONHEAP_RAM (hbo::INT 8), u32_i32) :-:
("raww16l", hbo::GET_FROM_NONHEAP_RAM (hbo::UNT 16), u32_u32) :-:
("rawi16l", hbo::GET_FROM_NONHEAP_RAM (hbo::INT 16), u32_i32) :-:
("rawu32l", hbo::GET_FROM_NONHEAP_RAM (hbo::UNT 32), u32_u32) :-:
("rawi32l", hbo::GET_FROM_NONHEAP_RAM (hbo::INT 32), u32_i32) :-:
("rawf32l", hbo::GET_FROM_NONHEAP_RAM (hbo::FLOAT 32), u32_f64) :-:
("rawf64l", hbo::GET_FROM_NONHEAP_RAM (hbo::FLOAT 64), u32_f64) :-:
("rawu8s", hbo::SET_NONHEAP_RAM (hbo::UNT 8), u32u32_u) :-:
("rawi8s", hbo::SET_NONHEAP_RAM (hbo::INT 8), u32i32_u) :-:
("raww16s", hbo::SET_NONHEAP_RAM (hbo::UNT 16), u32u32_u) :-:
("rawi16s", hbo::SET_NONHEAP_RAM (hbo::INT 16), u32i32_u) :-:
("rawu32s", hbo::SET_NONHEAP_RAM (hbo::UNT 32), u32u32_u) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("rawi32s", hbo::SET_NONHEAP_RAM (hbo::INT 32), u32i32_u) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("rawf32s", hbo::SET_NONHEAP_RAM (hbo::FLOAT 32), u32f64_u) :-: # 64-bit issue: This will become 64 on 64-bit implementations.
("rawf64s", 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_stale_stamp "uListVariable";
all_elements
=
[ ( sy::make_type_symbol "List",
mld::TYP_IN_API
{
typ => tt::ulist_typ,
module_stamp => ev,
is_a_replica => FALSE,
scope => 0
}
),
make_constructor_element ("NIL", tt::unil_dcon),
make_constructor_element ("!", tt::ucons_dcon)
];
all_symbols = map #1 all_elements;
api_record
=
{ stamp => sta::make_stale_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_package_inlining_data [],
#
typechecked_package => { stamp => sta::make_stale_stamp "uListPackage",
stub => NULL,
#
typerstore => tro::set (tro::empty, ev, mld::TYP_ENTRY tt::ulist_typ),
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
=
ty::TYPE_SCHEME_TYPE {
type_scheme_arg_eq_properties => [FALSE],
type_scheme => ty::TYPE_SCHEME { arity=>1, body=>ty::TYPE_SCHEME_ARG_I 0 }
};
fun make_variable_element ( (name, baseop, type), (symbols, elements, dacc, offset))
=
{ s = sy::make_value_symbol name;
sp = mld::VALUE_IN_API { type, slot=>offset };
d = ij::make_baseop_inlining_data (baseop, type);
( s ! symbols,
(s, sp) ! elements,
d ! dacc,
offset+1
);
};
my (all_symbols, all_elements, inf_list, _)
=
fold_forward make_variable_element ([],[],[], 0) all_primops;
my (all_symbols, all_elements, inf_list)
=
( reverse all_symbols,
reverse all_elements,
reverse inf_list
);
api_record
=
{ stamp => sta::make_stale_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_package_inlining_data inf_list,
#
typechecked_package
=>
{ stamp => sta::make_stale_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 #
(fn _ = stx::empty_stampmapstack)
#
(picklehash, pickle);
};
}; # package base_types_and_ops_symbolmapstack
end; # stipulate