[m-rev.] Final report for summer project
Nicholas David WATMOUGH
ndw at students.cs.mu.oz.au
Sun Mar 3 19:56:25 AEDT 2002
Firstly, my code is currently not working, and I consequently have no code
to commit to the repository. Therefore, I intend to continue working on my
code at least until I get a working change, which I can then commit.
In case this does not occur, I will outline the areas of the code that I
have changed, so that someone else can continue with what I have worked
on, so that it is not a complete waste. I have also attached a diff of
my changes so far.
The following files have been altered:
compiler/ml_call_gen.m
This was edited in three places in the ml_gen_generic_call
predicate to alter the use of the offset field id to use either
word_offset or byte_offset. The choice depends on the value of the
--unboxed-object-fields option, but I'm not sure it should. As my
changes were specifically directed to unboxing field structures,
and not function calls, this code should probably always use
word_offset.
compiler/ml_code_util.m
This code had four significant changes. Two predicates were added
to the file, calculate_arg_size/3 and combine_lists/3. The first
calculates the size of the next argument (ie 8 for floats, 1 for
chars, 4 otherwise), and the second takes two lists and returns a
list of pair-tuples of the original list items.
I altered the predicate fixup_newobj_in_atomic_statement/5, to
pass a list of pairs, rather than a list of rvals, to
init_field_n/8. I also altered init_field_n/8 to use byte_offset
and word_offset rather than offset.
Also, a number of predicates were altered to pass down the
module_info, so that it could be used by init_field_n, but, as
Fergus suggested, this should be changed so that fixup_newobj_info
struct which is already passed down should include the module
info.
compiler/ml_elim_nested.m
Altered use of offset in ml_gen_unchain_frame/4 function, to use
word_offset and byte_offset, though whether this should just use
word_offset I'm not sure.
Additionally, as for former file, a large number of predicates
were changed to pass down the globals into ml_gen_unchain_frame/4.
This should be changed to include the globals in the elim_info
structure that is already passed down.
compiler/ml_type_gen.m
Altered type assignment in ml_gen_field/7 predicate, to only
assign mlds__generic_type to a field if the --unboxed-object-field
option is not set.
compiler/ml_unify_gen.m
Altered predicate ml_gen_closure_field_lvals/7 to use byte_offset
and word_offset rather than offset. Not sure if byte offset here
is correct (ie should it take into account the sizes of the
closure args). This seems more like function parameters, wand
therefore should probably be in word_offset only.
Currently working on altering ml_gen_new_object/14 pred to
reorder field vals so floats line up on byte multiples of 8. This
was in preference to reordering the fields before outputting in C.
This required adding a new predicate, reorder_field_types/5,
which groups the floats at the beginning, followed by all word
sized fields, followed by chars.
Also altered ml_gen_new_object/14 to calculate object size in
bytes rather than words if --unboxed option is set. This uses new
pred calculate_storage_size/3.
Not sure about changing boxing of args in static construction in
this predicate. Similiarly, altered ml_type_as_field/4 to only
box args if --unboxed option is set, but am unsure if this is
correct.
Changed ml_gen_unify_args/14 and ml_gen_unify_args2/15 to use
byte_offset and word_offset rather than just offset. Also
calculated correct offsets in bytes in ml_gen_unify_args2.
Changed ml_gen_unify_arg/15 to use byte/word_offset rather than
just offset.
Finally, changed ml_gen_secondary_tag_rval/4 to use
byte/word_offset rather than offset.
compiler/mlds.m
Altered definition of mlds__lval - new_object to use
maybe(storage_unit), which can be bytes or words, rather than just
maybe(rval), which was assumed to be in words.
Altered defn of field id to change from offset to either
word_offset or byte_offset.
compiler/mlds_to_c.m
Altered mlds_output_atomic_stmt(_, _, NewObject, _)/6 predicate to
allocate space for the object in either bytes or words, depending
on whether the size is specified in bytes or words. Also altered
call to mlds_output_init_args/9 to call
mlds_output_unboxed_init_args/11 if --unboxed option is set. This
is a new predicate that I added, which doesn't box field vals when
initialising them.
Added pred reorder_field_types/4, but this has now been copied to
ml_unify_gen.m, where I am now trying to do the reordering.
Added pred get_type_size/4, which does the same thing as
calculate_arg_size in the ml_unify_gen.m module (perhaps there is
a module which both modules could import this pred from).
Altered mlds_output_lval to use byte_offset and word_offset. Also
changed the byte_offset version to use new macro from
mercury_tags.h, MR_hl_byte_field, which allocates space in bytes,
not words.
Finally, added pred convert_to_c_type, which takes an mlds__type,
and returns an equivalent type from the mercury_types.h file.
compiler/mlds_to_csharp.m
Altered write_csharp_lval to use byte and word_offset rather than
offset.
compiler/mlds_to_gcc.m
Altered gen_atomic_stmt/3 to allocate space in bytes rather than
words, if appropriate.
Altered gen_init_args/10 to assign field offsets using byte_offset
and word_offset.
Added pred determine_byte_offset/4, which does same task as
get_type_size in mlds_to_c.m and calculate_arg_size in
ml_unify_gen.m.
Altered build_lval/5 to use byte/word_offset rather than offset.
Further changes to byte_offset version probably required.
compiler/mlds_to_il.m
Altered rename_field_id/2 function to use byte/word_offset.
Altered atomic_statement_to_il/5 use bytes and words in allocation
size, as appropriate. Byte offsets in field have not been
implementedin IL backend, but this was necessary to match altered
definition of mlds__lval - new_object in mlds.m
Altered load/5 pred to use byte/word_offset rather than offset.
Altered get_fieldref/6 predicate to use byte/word_offset.
Also changed a large number of predicates to pass down
globals. Could possibly have altered il_info to include the
globals - this depends on whether the il info is passed down to
the relevant predicates anyway.
compiler/mlds_to_java.m
Altered output_lval to use byte/word_offsets.
compiler/mlds_to_mcpp.m
Altered write_managed_cpp_lval to use word/byte_offsete.
compiler/options.m
Added the following options:
* bits_per_byte - int - default 8
* bits_per_char - int - default 8
* bits_per_float - int - default 64
* unboxed_object_fields - bool - default no
runtime/mercury_tags.h
Added two macros, MR_hl_byte_field and MR_hl_mask_byte_field.
These are used to allocate space in bytes by ml_output_lval in
the mlds_to_c.m module.
runtime/mercury_types.h
Added type MR_Byte
This is all my changes.
If I can get them working, the following future changes could also be
made:
* RTTI changes corresponding to mlds changes
* Byte offsets for fields in other MLDS backends, such as Java and
C# (internal MLDS changes already done, so just need language
specific changes)
* Byte offsets for fields in LLDS
* LLDS function parameters in bytes
* LLDS stack allocation in bytes
* LLDS and MLDS arrays allocated in bytes
Thats all.
Thanks,
Nicolas
-------------- next part --------------
cvs diff: Diffing .
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing bytecode/test
cvs diff: Diffing compiler
Index: compiler/ml_call_gen.m
===================================================================
RCS file: /home/mercury1/repository//mercury/compiler/ml_call_gen.m,v
retrieving revision 1.30
diff -u -r1.30 ml_call_gen.m
--- compiler/ml_call_gen.m 6 Feb 2002 18:44:18 -0000 1.30
+++ compiler/ml_call_gen.m 26 Feb 2002 05:03:00 -0000
@@ -161,7 +161,19 @@
{ GenericCall = higher_order(ClosureVar, _PredOrFunc,
_Arity) },
ml_gen_var(ClosureVar, ClosureLval),
- { FieldId = offset(const(int_const(1))) },
+ { module_info_globals(ModuleInfo, Globals) },
+ { globals__lookup_bool_option(Globals, unboxed_object_fields,
+ Unboxed) },
+ { globals__lookup_int_option(Globals, bytes_per_word,
+ BytesPerWord) },
+ % XXX Perhaps this should be word_offset irrespective of the
+ % unboxed flag value, as this code relates to function
+ % parameters, which have not yet been implemented in bytes
+ { ( Unboxed = yes ->
+ FieldId = byte_offset(const(int_const(BytesPerWord)))
+ ;
+ FieldId = word_offset(const(int_const(1)))
+ ) },
% XXX are these types right?
{ FuncLval = field(yes(0), lval(ClosureLval), FieldId,
mlds__generic_type, ClosureArgType) },
@@ -179,8 +191,19 @@
%
% extract the base_typeclass_info from the typeclass_info
%
- { BaseTypeclassInfoFieldId =
- offset(const(int_const(0))) },
+ { module_info_globals(ModuleInfo, Globals) },
+ { globals__lookup_bool_option( Globals, unboxed_object_fields,
+ Unboxed ) },
+ % XXX Perhaps this should be word_offset irrespective of the
+ % unboxed flag value, as this code relates to function
+ % parameters, which have not yet been implemented in bytes
+ { ( Unboxed = yes ->
+ BaseTypeclassInfoFieldId
+ = byte_offset(const(int_const(0)))
+ ;
+ BaseTypeclassInfoFieldId
+ = word_offset(const(int_const(0)))
+ ) },
{ BaseTypeclassInfoLval = field(yes(0),
lval(TypeClassInfoLval), BaseTypeclassInfoFieldId,
mlds__generic_type, ClosureArgType) },
@@ -189,7 +212,19 @@
%
{ Offset = ml_base_typeclass_info_method_offset },
{ MethodFieldNum = MethodNum + Offset },
- { MethodFieldId = offset(const(int_const(MethodFieldNum))) },
+ % XXX Perhaps this should be word_offset irrespective of the
+ % unboxed flag value, as this code relates to function
+ % parameters, which have not yet been implemented in bytes
+ { ( Unboxed = yes ->
+ globals__lookup_int_option(Globals, bytes_per_word,
+ BytesPerWord),
+ MethodFieldBytes = MethodFieldNum * BytesPerWord,
+ MethodFieldId
+ = byte_offset(const(int_const(MethodFieldBytes)))
+ ;
+ MethodFieldId
+ = word_offset(const(int_const(MethodFieldNum)))
+ ) },
{ FuncLval = field(yes(0), lval(BaseTypeclassInfoLval),
MethodFieldId,
mlds__generic_type, mlds__generic_type) },
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury1/repository//mercury/compiler/ml_code_util.m,v
retrieving revision 1.55
diff -u -r1.55 ml_code_util.m
--- compiler/ml_code_util.m 18 Feb 2002 07:00:55 -0000 1.55
+++ compiler/ml_code_util.m 26 Feb 2002 05:14:46 -0000
@@ -2171,7 +2171,7 @@
=(MLGenInfo),
{ ml_gen_info_get_module_info(MLGenInfo, ModuleInfo) },
{ module_info_name(ModuleInfo, ModuleName) },
- { fixup_newobj(MLDS_TypeInfoStatement0,
+ { fixup_newobj(ModuleInfo, MLDS_TypeInfoStatement0,
mercury_module_name_to_mlds(ModuleName),
MLDS_TypeInfoStatement, MLDS_NewobjLocals) },
@@ -2307,46 +2307,49 @@
% in the specified statement, returning the local
% variable declarations needed for the stack allocation.
%
-:- pred fixup_newobj(mlds__statement::in, mlds_module_name::in,
+:- pred fixup_newobj(module_info::in, mlds__statement::in, mlds_module_name::in,
mlds__statement::out, mlds__defns::out) is det.
-fixup_newobj(Statement0, ModuleName, Statement, Defns) :-
+fixup_newobj(ModuleInfo, Statement0, ModuleName, Statement, Defns) :-
Statement0 = mlds__statement(Stmt0, Context),
Info0 = fixup_newobj_info(ModuleName, Context, [], counter__init(0)),
- fixup_newobj_in_stmt(Stmt0, Stmt, Info0, Info),
+ fixup_newobj_in_stmt(ModuleInfo, Stmt0, Stmt, Info0, Info),
Statement = mlds__statement(Stmt, Context),
Defns = Info^locals.
-:- pred fixup_newobj_in_statement(mlds__statement::in, mlds__statement::out,
- fixup_newobj_info::in, fixup_newobj_info::out) is det.
-fixup_newobj_in_statement(MLDS_Statement0, MLDS_Statement) -->
+:- pred fixup_newobj_in_statement(module_info::in, mlds__statement::in,
+ mlds__statement::out, fixup_newobj_info::in,
+ fixup_newobj_info::out) is det.
+fixup_newobj_in_statement(ModuleInfo, MLDS_Statement0, MLDS_Statement) -->
{ MLDS_Statement0 = mlds__statement(MLDS_Stmt0, Context) },
^context := Context,
- fixup_newobj_in_stmt(MLDS_Stmt0, MLDS_Stmt),
+ fixup_newobj_in_stmt(ModuleInfo, MLDS_Stmt0, MLDS_Stmt),
{ MLDS_Statement = mlds__statement(MLDS_Stmt, Context) }.
-:- pred fixup_newobj_in_stmt(mlds__stmt::in, mlds__stmt::out,
+:- pred fixup_newobj_in_stmt(module_info::in, mlds__stmt::in, mlds__stmt::out,
fixup_newobj_info::in, fixup_newobj_info::out) is det.
-fixup_newobj_in_stmt(Stmt0, Stmt) -->
+fixup_newobj_in_stmt(ModuleInfo, Stmt0, Stmt) -->
(
{ Stmt0 = block(Defns, Statements0) },
- list__map_foldl(fixup_newobj_in_statement,
+ list__map_foldl(fixup_newobj_in_statement(ModuleInfo),
Statements0, Statements),
{ Stmt = block(Defns, Statements) }
;
{ Stmt0 = while(Rval, Statement0, Once) },
- fixup_newobj_in_statement(Statement0, Statement),
+ fixup_newobj_in_statement(ModuleInfo, Statement0, Statement),
{ Stmt = while(Rval, Statement, Once) }
;
{ Stmt0 = if_then_else(Cond, Then0, MaybeElse0) },
- fixup_newobj_in_statement(Then0, Then),
- fixup_newobj_in_maybe_statement(MaybeElse0, MaybeElse),
+ fixup_newobj_in_statement(ModuleInfo, Then0, Then),
+ fixup_newobj_in_maybe_statement(ModuleInfo, MaybeElse0,
+ MaybeElse),
{ Stmt = if_then_else(Cond, Then, MaybeElse) }
;
{ Stmt0 = switch(Type, Val, Range, Cases0, Default0) },
- list__map_foldl(fixup_newobj_in_case, Cases0, Cases),
- fixup_newobj_in_default(Default0, Default),
+ list__map_foldl(fixup_newobj_in_case(ModuleInfo), Cases0,
+ Cases),
+ fixup_newobj_in_default(ModuleInfo, Default0, Default),
{ Stmt = switch(Type, Val, Range, Cases, Default) }
;
{ Stmt0 = label(_) },
@@ -2369,46 +2372,50 @@
{ Stmt = Stmt0 }
;
{ Stmt0 = try_commit(Ref, Statement0, Handler0) },
- fixup_newobj_in_statement(Statement0, Statement),
- fixup_newobj_in_statement(Handler0, Handler),
+ fixup_newobj_in_statement(ModuleInfo, Statement0, Statement),
+ fixup_newobj_in_statement(ModuleInfo, Handler0, Handler),
{ Stmt = try_commit(Ref, Statement, Handler) }
;
{ Stmt0 = atomic(AtomicStmt0) },
- fixup_newobj_in_atomic_statement(AtomicStmt0, Stmt)
+ fixup_newobj_in_atomic_statement(ModuleInfo, AtomicStmt0, Stmt)
).
-:- pred fixup_newobj_in_case(mlds__switch_case, mlds__switch_case,
+:- pred fixup_newobj_in_case(module_info, mlds__switch_case, mlds__switch_case,
fixup_newobj_info, fixup_newobj_info).
-:- mode fixup_newobj_in_case(in, out, in, out) is det.
+:- mode fixup_newobj_in_case(in, in, out, in, out) is det.
-fixup_newobj_in_case(Conds - Statement0, Conds - Statement) -->
- fixup_newobj_in_statement(Statement0, Statement).
+fixup_newobj_in_case(ModuleInfo, Conds - Statement0, Conds - Statement) -->
+ fixup_newobj_in_statement(ModuleInfo, Statement0, Statement).
-:- pred fixup_newobj_in_maybe_statement(maybe(mlds__statement),
+:- pred fixup_newobj_in_maybe_statement(module_info, maybe(mlds__statement),
maybe(mlds__statement), fixup_newobj_info, fixup_newobj_info).
-:- mode fixup_newobj_in_maybe_statement(in, out, in, out) is det.
+:- mode fixup_newobj_in_maybe_statement(in, in, out, in, out) is det.
-fixup_newobj_in_maybe_statement(no, no) --> [].
-fixup_newobj_in_maybe_statement(yes(Statement0), yes(Statement)) -->
- fixup_newobj_in_statement(Statement0, Statement).
-
-:- pred fixup_newobj_in_default(mlds__switch_default, mlds__switch_default,
- fixup_newobj_info, fixup_newobj_info).
-:- mode fixup_newobj_in_default(in, out, in, out) is det.
+fixup_newobj_in_maybe_statement(_ModuleInfo, no, no) --> [].
+fixup_newobj_in_maybe_statement(ModuleInfo, yes(Statement0), yes(Statement)) -->
+ fixup_newobj_in_statement(ModuleInfo, Statement0, Statement).
+
+:- pred fixup_newobj_in_default(module_info, mlds__switch_default,
+ mlds__switch_default, fixup_newobj_info, fixup_newobj_info).
+:- mode fixup_newobj_in_default(in, in, out, in, out) is det.
+
+fixup_newobj_in_default(_ModuleInfo, default_is_unreachable,
+ default_is_unreachable) --> [].
+fixup_newobj_in_default(_ModuleInfo, default_do_nothing, default_do_nothing)
+ --> [].
+fixup_newobj_in_default(ModuleInfo, default_case(Statement0),
+ default_case(Statement)) -->
+ fixup_newobj_in_statement(ModuleInfo, Statement0, Statement).
-fixup_newobj_in_default(default_is_unreachable, default_is_unreachable) --> [].
-fixup_newobj_in_default(default_do_nothing, default_do_nothing) --> [].
-fixup_newobj_in_default(default_case(Statement0), default_case(Statement)) -->
- fixup_newobj_in_statement(Statement0, Statement).
-
-:- pred fixup_newobj_in_atomic_statement(mlds__atomic_statement::in,
- mlds__stmt::out, fixup_newobj_info::in,
- fixup_newobj_info::out) is det.
-fixup_newobj_in_atomic_statement(AtomicStatement0, Stmt, Info0, Info) :-
+:- pred fixup_newobj_in_atomic_statement(module_info::in,
+ mlds__atomic_statement::in, mlds__stmt::out,
+ fixup_newobj_info::in, fixup_newobj_info::out) is det.
+fixup_newobj_in_atomic_statement(ModuleInfo, AtomicStatement0, Stmt, Info0,
+ Info) :-
(
AtomicStatement0 = new_object(Lval, MaybeTag, _HasSecTag,
PointerType, _MaybeSizeInWordsRval, _MaybeCtorName,
- ArgRvals, _ArgTypes)
+ ArgRvals, ArgTypes)
->
%
% generate the declaration of the new local variable
@@ -2449,9 +2456,12 @@
VarLval = mlds__var(qual(Info ^ module_name, VarName),
VarType),
PtrRval = mlds__unop(cast(PointerType), mem_addr(VarLval)),
+ % Avangion - this is messy. Also see if predicate already
+ % exists
+ combine_lists(ArgRvals, ArgTypes, ArgTupleList),
list__map_foldl(
- init_field_n(PointerType, PtrRval, Context),
- ArgRvals, ArgInitStatements, 0, _NumFields),
+ init_field_n(ModuleInfo, PointerType, PtrRval, Context),
+ ArgTupleList, ArgInitStatements, 0, _NumFields),
%
% generate code to assign the address of the new local
% variable to the Lval
@@ -2465,18 +2475,63 @@
Info = Info0
).
-:- pred init_field_n(mlds__type::in, mlds__rval::in,
- mlds__context::in, mlds__rval::in, mlds__statement::out,
- int::in, int::out) is det.
-init_field_n(PointerType, PointerRval, Context, ArgRval, Statement,
- FieldNum, FieldNum + 1) :-
- FieldId = offset(const(int_const(FieldNum))),
+:- pred combine_lists(list(T), list(U), list({T,U})).
+:- mode combine_lists(in, in, out) is det.
+
+combine_lists([], [], []).
+
+combine_lists([_|_], [], _) :-
+ error("combine lists: length mismatch").
+
+combine_lists([], [_|_], _) :-
+ error("combine lists: length mismatch").
+
+combine_lists([X|Xs], [Y|Ys], [Z|Zs]) :-
+ Z = {X, Y},
+ combine_lists(Xs, Ys, Zs).
+
+:- pred init_field_n(module_info::in, mlds__type::in, mlds__rval::in,
+ mlds__context::in, {mlds__rval, mlds__type}::in,
+ mlds__statement::out, int::in, int::out) is det.
+init_field_n(ModuleInfo, PointerType, PointerRval, Context, ArgTuple,
+ Statement, FieldOffset, NextFieldOffset) :-
+ ArgTuple = {ArgRval, ArgType},
+ module_info_globals(ModuleInfo, Globals),
+ globals__lookup_bool_option(Globals, unboxed_object_fields, Unboxed),
+ globals__lookup_int_option(Globals, bytes_per_word, BytesPerWord),
+ ( Unboxed = yes ->
+ ByteOffset = FieldOffset * BytesPerWord,
+ FieldId = byte_offset(const(int_const(ByteOffset))),
+ calculate_arg_size(Globals, ArgType, ArgSize),
+ NextFieldOffset = FieldOffset + ArgSize
+ ;
+ FieldId = word_offset(const(int_const(FieldOffset))),
+ NextFieldOffset = FieldOffset + 1
+ ),
% XXX FieldType is wrong for --high-level-data
FieldType = mlds__generic_type,
MaybeTag = yes(0),
Field = field(MaybeTag, PointerRval, FieldId, FieldType, PointerType),
AssignStmt = atomic(assign(Field, ArgRval)),
Statement = mlds__statement(AssignStmt, Context).
+
+:- pred calculate_arg_size(globals, mlds__type, int).
+:- mode calculate_arg_size(in, in, out) is det.
+
+calculate_arg_size(Globals, ArgType, ArgSize) :-
+ globals__lookup_int_option(Globals, bits_per_byte, BitsPerByte),
+ ( ArgType = mercury_type(_ProgType, float_type, _Exported_type) ->
+ globals__lookup_int_option(Globals, bits_per_float,
+ BitsPerFloat),
+ ArgSize = BitsPerFloat // BitsPerByte
+ ; ArgType = mercury_type(_ProgType, char_type, _ExportedType) ->
+ globals__lookup_int_option(Globals, bits_per_char, BitsPerChar),
+ ArgSize = BitsPerChar // BitsPerByte
+ ;
+ globals__lookup_int_option(Globals, bytes_per_word,
+ BytesPerWord),
+ ArgSize = BytesPerWord
+ ).
:- func maybe_tag_rval(maybe(mlds__tag), mlds__type, mlds__rval) = mlds__rval.
maybe_tag_rval(no, _Type, Rval) = Rval.
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury1/repository//mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.53
diff -u -r1.53 ml_elim_nested.m
--- compiler/ml_elim_nested.m 11 Feb 2002 16:48:19 -0000 1.53
+++ compiler/ml_elim_nested.m 13 Feb 2002 01:03:20 -0000
@@ -539,7 +539,7 @@
% add unlink statements before
% any explicit returns or tail calls
( Action = chain_gc_stack_frames ->
- add_unchain_stack_to_statement(
+ add_unchain_stack_to_statement(Globals,
FuncBody1, FuncBody2,
ElimInfo, _ElimInfo)
;
@@ -557,7 +557,7 @@
RetValues = []
->
UnchainFrame = [ml_gen_unchain_frame(
- Context, ElimInfo)]
+ Globals, Context, ElimInfo)]
;
UnchainFrame = []
),
@@ -2161,54 +2161,58 @@
%-----------------------------------------------------------------------------%
% Add code to unlink the stack chain before any explicit returns or tail calls.
-
-:- pred add_unchain_stack_to_maybe_statement(maybe(mlds__statement),
+%
+:- pred add_unchain_stack_to_maybe_statement(globals, maybe(mlds__statement),
maybe(mlds__statement), elim_info, elim_info).
-:- mode add_unchain_stack_to_maybe_statement(in, out, in, out) is det.
+:- mode add_unchain_stack_to_maybe_statement(in, in, out, in, out) is det.
-add_unchain_stack_to_maybe_statement(no, no) --> [].
-add_unchain_stack_to_maybe_statement(yes(Statement0), yes(Statement)) -->
- add_unchain_stack_to_statement(Statement0, Statement).
+add_unchain_stack_to_maybe_statement(_Globals, no, no) --> [].
+add_unchain_stack_to_maybe_statement(Globals, yes(Statement0), yes(Statement))
+ -->
+ add_unchain_stack_to_statement(Globals, Statement0, Statement).
-:- pred add_unchain_stack_to_statements(mlds__statements, mlds__statements,
- elim_info, elim_info).
-:- mode add_unchain_stack_to_statements(in, out, in, out) is det.
+:- pred add_unchain_stack_to_statements(globals, mlds__statements,
+ mlds__statements, elim_info, elim_info).
+:- mode add_unchain_stack_to_statements(in, in, out, in, out) is det.
-add_unchain_stack_to_statements(Statements0, Statements) -->
- list__map_foldl(add_unchain_stack_to_statement,
+add_unchain_stack_to_statements(Globals, Statements0, Statements) -->
+ list__map_foldl(add_unchain_stack_to_statement(Globals),
Statements0, Statements).
-:- pred add_unchain_stack_to_statement(mlds__statement, mlds__statement,
- elim_info, elim_info).
-:- mode add_unchain_stack_to_statement(in, out, in, out) is det.
+:- pred add_unchain_stack_to_statement(globals, mlds__statement,
+ mlds__statement, elim_info, elim_info).
+:- mode add_unchain_stack_to_statement(in, in, out, in, out) is det.
-add_unchain_stack_to_statement(Statement0, Statement) -->
+add_unchain_stack_to_statement(Globals, Statement0, Statement) -->
{ Statement0 = mlds__statement(Stmt0, Context) },
- add_unchain_stack_to_stmt(Stmt0, Context, Stmt),
+ add_unchain_stack_to_stmt(Globals, Stmt0, Context, Stmt),
{ Statement = mlds__statement(Stmt, Context) }.
-:- pred add_unchain_stack_to_stmt(mlds__stmt, mlds__context, mlds__stmt,
- elim_info, elim_info).
-:- mode add_unchain_stack_to_stmt(in, in, out, in, out) is det.
+:- pred add_unchain_stack_to_stmt(globals, mlds__stmt, mlds__context,
+ mlds__stmt, elim_info, elim_info).
+:- mode add_unchain_stack_to_stmt(in, in, in, out, in, out) is det.
-add_unchain_stack_to_stmt(Stmt0, Context, Stmt) -->
+add_unchain_stack_to_stmt(Globals, Stmt0, Context, Stmt) -->
(
{ Stmt0 = block(Defns, Statements0) },
- add_unchain_stack_to_statements(Statements0, Statements),
+ add_unchain_stack_to_statements(Globals, Statements0,
+ Statements),
{ Stmt = block(Defns, Statements) }
;
{ Stmt0 = while(Rval, Statement0, Once) },
- add_unchain_stack_to_statement(Statement0, Statement),
+ add_unchain_stack_to_statement(Globals, Statement0, Statement),
{ Stmt = while(Rval, Statement, Once) }
;
{ Stmt0 = if_then_else(Cond, Then0, MaybeElse0) },
- add_unchain_stack_to_statement(Then0, Then),
- add_unchain_stack_to_maybe_statement(MaybeElse0, MaybeElse),
+ add_unchain_stack_to_statement(Globals, Then0, Then),
+ add_unchain_stack_to_maybe_statement(Globals, MaybeElse0,
+ MaybeElse),
{ Stmt = if_then_else(Cond, Then, MaybeElse) }
;
{ Stmt0 = switch(Type, Val, Range, Cases0, Default0) },
- list__map_foldl(add_unchain_stack_to_case, Cases0, Cases),
- add_unchain_stack_to_default(Default0, Default),
+ list__map_foldl(add_unchain_stack_to_case(Globals), Cases0,
+ Cases),
+ add_unchain_stack_to_default(Globals, Default0, Default),
{ Stmt = switch(Type, Val, Range, Cases, Default) }
;
{ Stmt0 = label(_) },
@@ -2223,7 +2227,7 @@
{ Stmt0 = call(_Sig, _Func, _Obj, _Args, _RetLvals, TailCall) },
( { TailCall = tail_call } ->
=(ElimInfo),
- { Stmt = prepend_unchain_frame(Stmt0, Context,
+ { Stmt = prepend_unchain_frame(Globals, Stmt0, Context,
ElimInfo) }
;
{ Stmt = Stmt0 }
@@ -2231,55 +2235,58 @@
;
{ Stmt0 = return(_Rvals) },
=(ElimInfo),
- { Stmt = prepend_unchain_frame(Stmt0, Context, ElimInfo) }
+ { Stmt = prepend_unchain_frame(Globals, Stmt0, Context,
+ ElimInfo) }
;
{ Stmt0 = do_commit(_Ref) },
{ Stmt = Stmt0 }
;
{ Stmt0 = try_commit(Ref, Statement0, Handler0) },
- add_unchain_stack_to_statement(Statement0, Statement),
- add_unchain_stack_to_statement(Handler0, Handler),
+ add_unchain_stack_to_statement(Globals, Statement0, Statement),
+ add_unchain_stack_to_statement(Globals, Handler0, Handler),
{ Stmt = try_commit(Ref, Statement, Handler) }
;
{ Stmt0 = atomic(_AtomicStmt0) },
{ Stmt = Stmt0 }
).
-:- pred add_unchain_stack_to_case(mlds__switch_case, mlds__switch_case,
+:- pred add_unchain_stack_to_case(globals, mlds__switch_case, mlds__switch_case,
elim_info, elim_info).
-:- mode add_unchain_stack_to_case(in, out, in, out) is det.
+:- mode add_unchain_stack_to_case(in, in, out, in, out) is det.
-add_unchain_stack_to_case(Conds0 - Statement0, Conds - Statement) -->
+add_unchain_stack_to_case(Globals, Conds0 - Statement0, Conds - Statement) -->
list__map_foldl(fixup_case_cond, Conds0, Conds),
- add_unchain_stack_to_statement(Statement0, Statement).
-
-:- pred add_unchain_stack_to_default(mlds__switch_default, mlds__switch_default,
- elim_info, elim_info).
-:- mode add_unchain_stack_to_default(in, out, in, out) is det.
+ add_unchain_stack_to_statement(Globals, Statement0, Statement).
-add_unchain_stack_to_default(default_is_unreachable, default_is_unreachable)
+:- pred add_unchain_stack_to_default(globals, mlds__switch_default,
+ mlds__switch_default, elim_info, elim_info).
+:- mode add_unchain_stack_to_default(in, in, out, in, out) is det.
+
+add_unchain_stack_to_default(_Globals, default_is_unreachable,
+ default_is_unreachable) --> [].
+add_unchain_stack_to_default(_Globals, default_do_nothing, default_do_nothing)
--> [].
-add_unchain_stack_to_default(default_do_nothing, default_do_nothing) --> [].
-add_unchain_stack_to_default(default_case(Statement0), default_case(Statement))
- -->
- add_unchain_stack_to_statement(Statement0, Statement).
+add_unchain_stack_to_default(Globals, default_case(Statement0),
+ default_case(Statement)) -->
+ add_unchain_stack_to_statement(Globals, Statement0, Statement).
-:- func prepend_unchain_frame(mlds__stmt, mlds__context, elim_info) =
+:- func prepend_unchain_frame(globals, mlds__stmt, mlds__context, elim_info) =
mlds__stmt.
-prepend_unchain_frame(Stmt0, Context, ElimInfo) = Stmt :-
- UnchainFrame = ml_gen_unchain_frame(Context, ElimInfo),
+prepend_unchain_frame(Globals, Stmt0, Context, ElimInfo) = Stmt :-
+ UnchainFrame = ml_gen_unchain_frame(Globals, Context, ElimInfo),
Statement0 = mlds__statement(Stmt0, Context),
Stmt = block([], [UnchainFrame, Statement0]).
-:- func append_unchain_frame(mlds__stmt, mlds__context, elim_info) =
+:- func append_unchain_frame(globals, mlds__stmt, mlds__context, elim_info) =
mlds__stmt.
-append_unchain_frame(Stmt0, Context, ElimInfo) = Stmt :-
- UnchainFrame = ml_gen_unchain_frame(Context, ElimInfo),
+append_unchain_frame(Globals, Stmt0, Context, ElimInfo) = Stmt :-
+ UnchainFrame = ml_gen_unchain_frame(Globals, Context, ElimInfo),
Statement0 = mlds__statement(Stmt0, Context),
Stmt = block([], [Statement0, UnchainFrame]).
-:- func ml_gen_unchain_frame(mlds__context, elim_info) = mlds__statement.
-ml_gen_unchain_frame(Context, ElimInfo) = UnchainFrame :-
+:- func ml_gen_unchain_frame(globals, mlds__context, elim_info)
+ = mlds__statement.
+ml_gen_unchain_frame(Globals, Context, ElimInfo) = UnchainFrame :-
EnvPtrTypeName = ElimInfo ^ env_ptr_type_name,
%
% Generate code to remove this frame from the stack chain:
@@ -2299,7 +2306,12 @@
%
StackChain = ml_stack_chain_var,
Tag = yes(0),
- PrevFieldId = offset(const(int_const(0))),
+ globals__lookup_bool_option(Globals, unboxed_object_fields, Unboxed),
+ ( Unboxed = yes ->
+ PrevFieldId = byte_offset(const(int_const(0)))
+ ;
+ PrevFieldId = word_offset(const(int_const(0)))
+ ),
PrevFieldType = mlds__generic_type,
PrevFieldRval = lval(field(Tag, lval(StackChain), PrevFieldId,
PrevFieldType, EnvPtrTypeName)),
Index: compiler/ml_type_gen.m
===================================================================
RCS file: /home/mercury1/repository//mercury/compiler/ml_type_gen.m,v
retrieving revision 1.24
diff -u -r1.24 ml_type_gen.m
--- compiler/ml_type_gen.m 26 Feb 2002 02:45:48 -0000 1.24
+++ compiler/ml_type_gen.m 26 Feb 2002 03:02:04 -0000
@@ -865,10 +865,16 @@
ml_gen_field(ModuleInfo, Context, MaybeFieldName, Type, MLDS_Defn,
ArgNum0, ArgNum) :-
- ( ml_must_box_field_type(Type, ModuleInfo) ->
- MLDS_Type = mlds__generic_type
- ;
+ module_info_globals(ModuleInfo, Globals),
+ globals__lookup_bool_option(Globals, unboxed_object_fields, Unboxed),
+ ( Unboxed = yes ->
MLDS_Type = mercury_type_to_mlds_type(ModuleInfo, Type)
+ ;
+ ( ml_must_box_field_type(Type, ModuleInfo) ->
+ MLDS_Type = mlds__generic_type
+ ;
+ MLDS_Type = mercury_type_to_mlds_type(ModuleInfo, Type)
+ )
),
FieldName = ml_gen_field_name(MaybeFieldName, ArgNum0),
MLDS_Defn = ml_gen_mlds_field_decl(var(mlds__var_name(FieldName, no)),
Index: compiler/ml_unify_gen.m
===================================================================
RCS file: /home/mercury1/repository//mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.52
diff -u -r1.52 ml_unify_gen.m
--- compiler/ml_unify_gen.m 20 Feb 2002 03:14:13 -0000 1.52
+++ compiler/ml_unify_gen.m 26 Feb 2002 06:39:20 -0000
@@ -1006,10 +1006,21 @@
( { ArgNum > NumClosureArgs } ->
{ ClosureArgLvals = [] }
;
+ ml_gen_info_get_globals(Globals),
+ { globals__lookup_bool_option(Globals, unboxed_object_fields,
+ Unboxed) },
+ { globals__lookup_int_option(Globals, bytes_per_word, BytesPerWord ) },
%
% generate `MR_field(MR_mktag(0), closure, <N>)'
%
- { FieldId = offset(const(int_const(ArgNum + Offset))) },
+ { TotalOffset = ArgNum + Offset },
+ { ( Unboxed = yes ->
+ % Avangion - is this the right offset in bytes?
+ ByteOffset = TotalOffset * BytesPerWord,
+ FieldId = byte_offset(const(int_const(ByteOffset)))
+ ;
+ FieldId = word_offset(const(int_const(TotalOffset)))
+ ) },
% XXX these types might not be right
{ FieldLval = field(yes(0), lval(ClosureLval), FieldId,
mlds__generic_type, mlds__generic_type) },
@@ -1135,8 +1146,13 @@
;
MaybeTag = yes(Tag)
},
+ % XXX This reorders the fields of a struct so that a float
+ % starts on a multiple of 8, however, not sure if this will
+ % cause problems elsewhere, such as RTTI
+ =(MLDSGenInfo),
+ { ml_gen_info_get_module_info(MLDSGenInfo, ModuleInfo) },
+ reorder_field_types(ModuleInfo, ArgVars, ArgVars0),
ml_variable_types(ArgVars, ArgTypes),
-
(
{ HowToConstruct = construct_dynamically },
@@ -1159,11 +1175,21 @@
{ list__append(ExtraTypes, MLDS_ArgTypes0, MLDS_ArgTypes) },
%
- % Compute the number of bytes to allocate
+ % Compute the amount of space to allocate, in bytes or words,
+ % depending on the value of the --unboxed-object-fields
+ % compiler flag
%
- { list__length(ArgRvals, NumArgs) },
- { SizeInWordsRval = const(int_const(NumArgs)) },
-
+ { module_info_globals(ModuleInfo, Globals) },
+ { globals__lookup_bool_option(Globals, unboxed_object_fields,
+ Unboxed) },
+ { ( Unboxed = yes ->
+ calculate_storage_size(ModuleInfo, ArgTypes,
+ SizeInBytes),
+ SizeStorage = bytes(const(int_const(SizeInBytes)))
+ ;
+ list__length(ArgRvals, NumArgs),
+ SizeStorage = words(const(int_const(NumArgs)))
+ ) },
%
% Generate a `new_object' statement to dynamically allocate
% the memory for this term from the heap. The `new_object'
@@ -1171,7 +1197,7 @@
% with the specified arguments.
%
{ MakeNewObject = new_object(VarLval, MaybeTag, HasSecTag,
- MLDS_Type, yes(SizeInWordsRval), MaybeCtorName,
+ MLDS_Type, yes(SizeStorage), MaybeCtorName,
ArgRvals, MLDS_ArgTypes) },
{ MLDS_Stmt = atomic(MakeNewObject) },
{ MLDS_Statement = mlds__statement(MLDS_Stmt,
@@ -1200,9 +1226,12 @@
% Box or unbox the arguments, if needed,
% and insert the extra rvals at the start
%
+ % Avangion - Do I change this?
ml_gen_info_get_globals(Globals),
{ globals__lookup_bool_option(Globals, highlevel_data,
HighLevelData) },
+ %% { globals__lookup_bool_option(Globals, unboxed_object_fields,
+ %% Unboxed) },
(
{ HighLevelData = no },
%
@@ -1215,13 +1244,21 @@
Context, BoxConstDefns, ArgRvals)
;
{ HighLevelData = yes },
- ml_gen_box_or_unbox_const_rval_list(ArgTypes,
- FieldTypes, ArgRvals0,
- Context, BoxConstDefns, ArgRvals1),
- % For --high-level-data, the ExtraRvals should
- % already have the right type, so we don't need
- % to worry about boxing or unboxing them
- { list__append(ExtraRvals, ArgRvals1, ArgRvals) }
+ %% (
+ %% { Unboxed = yes },
+ %% { list__append(ExtraRvals, ArgRvals0,
+ %% ArgRvals) }
+ %% ;
+ %% { Unboxed = no },
+ ml_gen_box_or_unbox_const_rval_list(ArgTypes,
+ FieldTypes, ArgRvals0,
+ Context, BoxConstDefns, ArgRvals1),
+ % For --high-level-data, the ExtraRvals should
+ % already have the right type, so we don't need
+ % to worry about boxing or unboxing them
+ { list__append(ExtraRvals, ArgRvals1,
+ ArgRvals) }
+ %% )
),
%
@@ -1323,6 +1360,79 @@
{ MLDS_Statements = [MLDS_Statement | MLDS_Statements0] }
).
+:- pred reorder_field_types(module_info, list(prog_var), list(prog_var),
+ ml_gen_info, ml_gen_info).
+:- mode reorder_field_types(in, in, out, in, out) is det.
+
+reorder_field_types(ModuleInfo, Args, Args0) -->
+ get_float_list(ModuleInfo, Args, FloatArgs, Args1),
+ get_char_list(ModuleInfo, Args1, CharArgs, Args2),
+ { Args0 = FloatArgs ++ Args2 ++ CharArgs }.
+
+
+:- pred get_float_list(module_info, list(prog_var), list(prog_var),
+ list(prog_var), ml_gen_info, ml_gen_info).
+:- mode get_float_list(in, in, out, out, in, out) is det.
+
+get_float_list(_ModuleInfo, [], [], []) --> [].
+get_float_list(ModuleInfo, [Arg|Args], FloatArgs, NonFloatArgs) -->
+ ml_variable_type(Arg, ArgType),
+ { classify_type(ArgType, ModuleInfo, BuiltinType) },
+ ( { BuiltinType = float_type } ->
+ get_float_list(ModuleInfo, Args, FloatArgs0, NonFloatArgs),
+ { FloatArgs = [Arg | FloatArgs0] }
+ ;
+ get_float_list(ModuleInfo, Args, FloatArgs, NonFloatArgs0),
+ { NonFloatArgs = [Arg | NonFloatArgs0] }
+ ).
+
+:- pred get_char_list(module_info, list(prog_var), list(prog_var),
+ list(prog_var), ml_gen_info, ml_gen_info).
+:- mode get_char_list(in, in, out, out, in, out) is det.
+
+get_char_list(_ModuleInfo, [], [], []) --> [].
+get_char_list(ModuleInfo, [Arg|Args], CharArgs, Args0) -->
+ ml_variable_type(Arg, ArgType),
+ { classify_type(ArgType, ModuleInfo, BuiltinType) },
+ ( { BuiltinType = char_type } ->
+ { CharArgs = [Arg|CharArgs0] },
+ get_char_list(ModuleInfo, Args, CharArgs0, Args0)
+ ;
+ { Args0 = [Arg|Args1] },
+ get_char_list(ModuleInfo, Args, CharArgs, Args1)
+ ).
+
+:- pred calculate_storage_size(module_info, list(prog_type), int).
+:- mode calculate_storage_size(in, in, out) is det.
+
+calculate_storage_size(_ModuleInfo, [], 0).
+
+calculate_storage_size(ModuleInfo, [ArgType|ArgTypes], SizeInBytes) :-
+ calculate_arg_size(ModuleInfo, ArgType, ArgSizeInBytes),
+ calculate_storage_size(ModuleInfo, ArgTypes, TotalSize),
+ SizeInBytes = TotalSize + ArgSizeInBytes.
+
+:- pred calculate_arg_size(module_info, prog_type, int).
+:- mode calculate_arg_size(in, in, out) is det.
+
+calculate_arg_size(ModuleInfo, ArgType, ArgSizeInBytes) :-
+ classify_type(ArgType, ModuleInfo, BuiltinType),
+ module_info_globals(ModuleInfo, Globals),
+ globals__lookup_int_option(Globals, bits_per_byte, BitsPerByte),
+ ( BuiltinType = char_type ->
+ globals__lookup_int_option(Globals, bits_per_char,
+ BitsPerChar),
+ ArgSizeInBytes = BitsPerChar // BitsPerByte
+ ; BuiltinType = float_type ->
+ globals__lookup_int_option(Globals, bits_per_float,
+ BitsPerFloat),
+ ArgSizeInBytes = BitsPerFloat // BitsPerByte
+ ;
+ globals__lookup_int_option(Globals, bytes_per_word,
+ BytesPerWord),
+ ArgSizeInBytes = BytesPerWord
+ ).
+
% Return the MLDS type suitable for constructing a constant static
% ground term with the specified cons_id.
:- func get_type_for_cons_id(mlds__type, bool, maybe(cons_id), bool)
@@ -1431,9 +1541,13 @@
% we don't box everything, but for the MLDS->C and MLDS->asm
% back-ends we still need to box floating point fields
%
+ % Avangion - I'm not sure I should be changing this.
+ module_info_globals(ModuleInfo, Globals),
+ globals__lookup_bool_option(Globals, unboxed_object_fields, Unboxed),
(
HighLevelData = no
;
+ Unboxed = no,
HighLevelData = yes,
ml_must_box_field_type(FieldType, ModuleInfo)
)
@@ -2022,10 +2136,22 @@
ml_gen_unify_args(ConsId, Args, Modes, ArgTypes, Fields, VarType, VarLval,
Offset, ArgNum, Tag, Context, MLDS_Statements) -->
+ ml_gen_info_get_globals(Globals),
+ { globals__lookup_bool_option(Globals, unboxed_object_fields, Unboxed) },
+ { globals__lookup_int_option(Globals, bytes_per_word, BytesPerWord) },
(
- ml_gen_unify_args_2(ConsId, Args, Modes, ArgTypes, Fields,
- VarType, VarLval, Offset, ArgNum, Tag, Context,
- [], MLDS_Statements0)
+ ( { Unboxed = yes } ->
+ { Offset1 = Offset * BytesPerWord },
+ ml_gen_unify_args_2(ConsId, Args, Modes, ArgTypes,
+ Fields, VarType, VarLval,
+ byte_offset(const(int_const(Offset1))), ArgNum, Tag,
+ Context, [], MLDS_Statements0)
+ ;
+ ml_gen_unify_args_2(ConsId, Args, Modes, ArgTypes,
+ Fields, VarType, VarLval,
+ word_offset(const(int_const(Offset))), ArgNum, Tag,
+ Context, [], MLDS_Statements0)
+ )
->
{ MLDS_Statements = MLDS_Statements0 }
;
@@ -2033,7 +2159,7 @@
).
:- pred ml_gen_unify_args_2(cons_id, prog_vars, list(uni_mode), list(prog_type),
- list(constructor_arg), prog_type, mlds__lval, int, int,
+ list(constructor_arg), prog_type, mlds__lval, field_id, int,
cons_tag, prog_context, mlds__statements, mlds__statements,
ml_gen_info, ml_gen_info).
:- mode ml_gen_unify_args_2(in, in, in, in, in, in, in, in, in, in, in, in, out,
@@ -2042,26 +2168,47 @@
ml_gen_unify_args_2(_, [], [], [], _, _, _, _, _, _, _, Statements, Statements)
--> [].
ml_gen_unify_args_2(ConsId, [Arg|Args], [Mode|Modes], [ArgType|ArgTypes],
- [Field|Fields], VarType, VarLval, Offset, ArgNum, Tag,
+ [Field|Fields], VarType, VarLval, ByteOrWordOffset, ArgNum, Tag,
Context, MLDS_Statements0, MLDS_Statements) -->
- { Offset1 = Offset + 1 },
{ ArgNum1 = ArgNum + 1 },
- ml_gen_unify_args_2(ConsId, Args, Modes, ArgTypes, Fields, VarType,
- VarLval, Offset1, ArgNum1, Tag, Context,
- MLDS_Statements0, MLDS_Statements1),
- ml_gen_unify_arg(ConsId, Arg, Mode, ArgType, Field, VarType, VarLval,
- Offset, ArgNum, Tag, Context,
+ (
+ %
+ % For field offsets in bytes, we need to determine the next
+ % offset, OffsetInBytes1, based on the size of the current
+ % field type, ArgType, and the current offset, OffsetInBytes.
+ %
+ { ByteOrWordOffset =
+ byte_offset(const(int_const(OffsetInBytes))) },
+ =(Info),
+ { ml_gen_info_get_module_info(Info, ModuleInfo) },
+ { calculate_arg_size(ModuleInfo, ArgType, ArgSizeInBytes) },
+ { OffsetInBytes1 = OffsetInBytes + ArgSizeInBytes },
+ ml_gen_unify_args_2(ConsId, Args, Modes, ArgTypes, Fields,
+ VarType, VarLval,
+ byte_offset(const(int_const(OffsetInBytes1))), ArgNum1,
+ Tag, Context, MLDS_Statements0, MLDS_Statements1)
+ ;
+ { ByteOrWordOffset =
+ word_offset(const(int_const(OffsetInWords))) },
+ ml_gen_unify_args_2(ConsId, Args, Modes, ArgTypes, Fields,
+ VarType, VarLval,
+ word_offset(const(int_const(OffsetInWords + 1))),
+ ArgNum1, Tag, Context, MLDS_Statements0,
+ MLDS_Statements1)
+ ),
+ ml_gen_unify_arg(ConsId, Arg, Mode, ArgType, Field, VarType,
+ VarLval, ByteOrWordOffset, ArgNum, Tag, Context,
MLDS_Statements1, MLDS_Statements).
:- pred ml_gen_unify_arg(cons_id, prog_var, uni_mode, prog_type,
- constructor_arg, prog_type, mlds__lval, int, int, cons_tag,
+ constructor_arg, prog_type, mlds__lval, field_id, int, cons_tag,
prog_context, mlds__statements, mlds__statements,
ml_gen_info, ml_gen_info).
:- mode ml_gen_unify_arg(in, in, in, in, in, in, in, in, in, in, in, in, out,
in, out) is det.
ml_gen_unify_arg(ConsId, Arg, Mode, ArgType, Field, VarType, VarLval,
- Offset, ArgNum, Tag, Context,
+ ByteOrWordOffset, ArgNum, Tag, Context,
MLDS_Statements0, MLDS_Statements) -->
{ Field = MaybeFieldName - FieldType },
=(Info),
@@ -2075,7 +2222,7 @@
% we access all fields using offsets.
%
HighLevelData = no,
- FieldId = offset(const(int_const(Offset)))
+ FieldId = ByteOrWordOffset
;
%
% With the high-level data representation,
@@ -2084,7 +2231,7 @@
%
HighLevelData = yes,
( type_is_tuple(VarType, _) ->
- FieldId = offset(const(int_const(Offset)))
+ FieldId = ByteOrWordOffset
;
FieldName = ml_gen_field_name(MaybeFieldName, ArgNum),
(
@@ -2101,6 +2248,7 @@
%
% Box the field type, if needed
%
+ % Avangion - Do I need to change this?
{ ml_type_as_field(FieldType, ModuleInfo, HighLevelData,
BoxedFieldType) },
@@ -2347,16 +2495,25 @@
MLDS_VarType = mercury_type_to_mlds_type(ModuleInfo, VarType),
module_info_globals(ModuleInfo, Globals),
globals__lookup_bool_option(Globals, highlevel_data, HighLevelData),
+ globals__lookup_bool_option(Globals, unboxed_object_fields, Unboxed),
( HighLevelData = no ->
% Note: with the low-level data representation,
% all fields -- even the secondary tag -- are boxed,
% and so we need to unbox (i.e. cast) it back to the
% right type here.
- SecondaryTagField =
- unop(unbox(mlds__native_int_type),
- lval(field(yes(PrimaryTagVal), Rval,
- offset(const(int_const(0))),
- mlds__generic_type, MLDS_VarType)))
+ ( Unboxed = yes ->
+ SecondaryTagField =
+ unop(unbox(mlds__native_int_type),
+ lval(field(yes(PrimaryTagVal), Rval,
+ byte_offset(const(int_const(0))),
+ mlds__generic_type, MLDS_VarType)))
+ ;
+ SecondaryTagField =
+ unop(unbox(mlds__native_int_type),
+ lval(field(yes(PrimaryTagVal), Rval,
+ word_offset(const(int_const(0))),
+ mlds__generic_type, MLDS_VarType)))
+ )
;
FieldId = ml_gen_hl_tag_field_id(VarType, ModuleInfo),
SecondaryTagField = lval(field(yes(PrimaryTagVal), Rval,
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository//mercury/compiler/mlds.m,v
retrieving revision 1.84
diff -u -r1.84 mlds.m
--- compiler/mlds.m 27 Feb 2002 13:56:57 -0000 1.84
+++ compiler/mlds.m 28 Feb 2002 04:53:46 -0000
@@ -1142,10 +1142,10 @@
% in the argument list (see below).
mlds__type, % The type of the object being
% allocated.
- maybe(mlds__rval),
+ maybe(storage_unit),
% The amount of memory that needs to
% be allocated for the new object,
- % measured in words (NOT bytes!).
+ % measured in either bytes or words
maybe(ctor_name),
% The name of the constructor to
% invoke.
@@ -1238,6 +1238,16 @@
.
%
+ % This type is used to indicate whether object field offsets are
+ % to be measured in either bytes or words
+ %
+:- type storage_unit
+ ---> bytes(mlds__rval)
+ ; words(mlds__rval)
+ .
+
+
+ %
% This is just a random selection of possible languages
% that we might want to target...
%
@@ -1312,9 +1322,12 @@
%
:- type field_id
- ---> % offset(N) represents the field
+ ---> % word_offset(N) represents the field
% at offset N Words.
- offset(mlds__rval)
+ word_offset(mlds__rval)
+ ; % byte_offset(N) represents the field at
+ % offset N bytes.
+ byte_offset(mlds__rval)
; % named_field(Name, CtorType) represents the field
% with the specified name. The CtorType gives the
% MLDS type for this particular constructor.
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository//mercury/compiler/mlds_to_c.m,v
retrieving revision 1.120
diff -u -r1.120 mlds_to_c.m
--- compiler/mlds_to_c.m 18 Feb 2002 07:00:56 -0000 1.120
+++ compiler/mlds_to_c.m 26 Feb 2002 03:27:53 -0000
@@ -2604,8 +2604,14 @@
io__write_string(", "),
( { MaybeSize = yes(Size) } ->
io__write_string("("),
- mlds_output_rval(Size),
- io__write_string(" * sizeof(MR_Word))")
+ ( { Size = bytes(SizeInBytes) },
+ mlds_output_rval(SizeInBytes),
+ io__write_string(")")
+ ;
+ { Size = words(SizeInWords) },
+ mlds_output_rval(SizeInWords),
+ io__write_string(" * sizeof(MR_Word))")
+ )
;
% XXX what should we do here?
io__write_int(-1)
@@ -2623,8 +2629,18 @@
io__write_string(")"),
io__write_string(EndMkword),
io__write_string(";\n"),
- mlds_output_init_args(Args, ArgTypes, Context, 0, Target, Tag,
- Indent + 1),
+ globals__io_lookup_bool_option(unboxed_object_fields, Unboxed),
+ globals__io_lookup_bool_option(highlevel_data, HighLevelData),
+ (
+ { Unboxed = yes },
+ { HighLevelData = yes }
+ ->
+ mlds_output_unboxed_init_args(Args, ArgTypes, Context, 0,
+ Target, Type, FuncInfo, Tag, Indent + 1)
+ ;
+ mlds_output_init_args(Args, ArgTypes, Context, 0, Target, Tag,
+ Indent + 1)
+ ),
mlds_indent(Context, Indent),
io__write_string("}\n").
@@ -2667,6 +2683,71 @@
outline_foreign_proc(_ForeignLang, _Lvals, _Code), _Context) -->
{ error("mlds_to_c.m: outline_foreign_proc is not used in C backend") }.
+
+:- pred reorder_field_types(list(mlds__rval), list(mlds__type),
+ list(mlds__rval), list(mlds__type)).
+:- mode reorder_field_types(in, in, out, out) is det.
+
+reorder_field_types(Args, ArgTypes, Args0, ArgTypes0) :-
+ get_float_list(Args, ArgTypes, FloatArgs, FloatTypes, Args1, ArgTypes1),
+ get_char_list(Args1, ArgTypes1, CharArgs, CharTypes, Args2, ArgTypes2),
+ Args0 = FloatArgs ++ Args2 ++ CharArgs,
+ ArgTypes0 = FloatTypes ++ ArgTypes2 ++ CharTypes.
+
+
+:- pred get_float_list(list(mlds__rval), list(mlds__type), list(mlds__rval),
+ list(mlds__type), list(mlds__rval), list(mlds__type)).
+:- mode get_float_list(in, in, out, out, out, out) is det.
+
+get_float_list([], [], [], [], [], []).
+
+get_float_list([_|_], [], _, _, _, _) :-
+ error("get_float_list: length mismatch").
+
+get_float_list([], [_|_], _, _, _, _) :-
+ error("get_float_list: length mismatch").
+
+get_float_list([Arg|Args], [ArgType|ArgTypes], FloatArgs, FloatTypes, Args0,
+ ArgTypes0) :-
+ ( ArgType = mercury_type( _ProgType, float_type, _ExportedType) ->
+ FloatArgs = [Arg|FloatArgs0],
+ FloatTypes = [ArgType|FloatTypes0],
+ get_float_list(Args, ArgTypes, FloatArgs0, FloatTypes0, Args0,
+ ArgTypes0)
+ ;
+ Args0 = [Arg|Args1],
+ ArgTypes0 = [ArgType|ArgTypes1],
+ get_float_list(Args, ArgTypes, FloatArgs, FloatTypes, Args1,
+ ArgTypes1)
+ ).
+
+:- pred get_char_list(list(mlds__rval), list(mlds__type), list(mlds__rval),
+ list(mlds__type), list(mlds__rval), list(mlds__type)).
+:- mode get_char_list(in, in, out, out, out, out) is det.
+
+get_char_list([], [], [], [], [], []).
+
+get_char_list([_|_], [], _, _, _, _) :-
+ error("get_char_list: length mismatch").
+
+get_char_list([], [_|_], _, _, _, _) :-
+ error("get_char_list: length mismatch").
+
+get_char_list([Arg|Args], [ArgType|ArgTypes], CharArgs, CharTypes, Args0,
+ ArgTypes0) :-
+ ( ArgType = mercury_type( _ProgType, char_type, _ExportedType) ->
+ CharArgs = [Arg|CharArgs0],
+ CharTypes = [ArgType|CharTypes0],
+ get_char_list(Args, ArgTypes, CharArgs0, CharTypes0, Args0,
+ ArgTypes0)
+ ;
+ Args0 = [Arg|Args1],
+ ArgTypes0 = [ArgType|ArgTypes1],
+ get_char_list(Args, ArgTypes, CharArgs, CharTypes, Args1,
+ ArgTypes1)
+ ).
+
+
:- pred mlds_output_target_code_component(mlds__context, target_code_component,
io__state, io__state).
:- mode mlds_output_target_code_component(in, in, di, uo) is det.
@@ -2709,9 +2790,9 @@
{ error("mlds_output_init_args: length mismatch") }.
mlds_output_init_args([], [_|_], _, _, _, _, _) -->
{ error("mlds_output_init_args: length mismatch") }.
-mlds_output_init_args([], [], _, _, _, _, _) --> [].
-mlds_output_init_args([Arg|Args], [ArgType|ArgTypes], Context,
- ArgNum, Target, Tag, Indent) -->
+mlds_output_init_args([], [], _, _, _, _, _ ) --> [].
+mlds_output_init_args([Arg|Args], [ArgType|ArgTypes], Context, ArgOffset,
+ Target, Tag, Indent) -->
%
% The MR_hl_field() macro expects its argument to
% have type MR_Box, so we need to box the arguments
@@ -2729,13 +2810,79 @@
io__write_string(", "),
mlds_output_lval(Target),
io__write_string(", "),
- io__write_int(ArgNum),
+ io__write_int(ArgOffset),
io__write_string(") = "),
mlds_output_boxed_rval(ArgType, Arg),
io__write_string(";\n"),
- mlds_output_init_args(Args, ArgTypes, Context,
- ArgNum + 1, Target, Tag, Indent).
-
+ %% { FieldLval = field(yes(Tag), lval(Target),
+ %% word_offset(const(int_const(ArgOffset))), ArgType,
+ %% Type) },
+ %% mlds_output_lval(FieldLval),
+ %% io__write_string(" = "),
+ %% mlds_output_boxed_rval(ArgType, Arg),
+ %% io__write_string(";\n"),
+ mlds_output_init_args(Args, ArgTypes, Context, ArgOffset + 1, Target,
+ Tag, Indent).
+
+:- pred mlds_output_unboxed_init_args(list(mlds__rval), list(mlds__type),
+ mlds__context, int, mlds__lval, mlds__type, func_info,
+ mlds__tag, indent, io__state, io__state).
+:- mode mlds_output_unboxed_init_args(in, in, in, in, in, in, in, in, in, di,
+ uo) is det.
+
+mlds_output_unboxed_init_args([_|_], [], _, _, _, _, _, _, _) -->
+ { error("mlds_output_unboxed_init_args: length mismatch") }.
+mlds_output_unboxed_init_args([], [_|_], _, _, _, _, _, _, _) -->
+ { error("mlds_output_unboxed_init_args: length mismatch") }.
+mlds_output_unboxed_init_args([], [], _, _, _, _, _, _, _) --> [].
+mlds_output_unboxed_init_args([Arg|Args], [ArgType|ArgTypes], Context,
+ ArgOffset, Target, Type, FuncInfo, Tag, Indent) -->
+ % XXX For --high-level-data, we ought to generate
+ % assignments to the fields (or perhaps a call to
+ % a constructor function) rather than using the
+ % MR_hl_field() macro.
+ %
+ mlds_to_c__output_context(Context),
+ { FieldLval = field(yes(Tag), lval(Target),
+ byte_offset(const(int_const(ArgOffset))), ArgType, Type) },
+ mlds_output_atomic_stmt(Indent, FuncInfo, assign(FieldLval, Arg),
+ Context),
+ % mlds_indent(Context, Indent),
+ % io__write_string("MR_hl_byte_field("),
+ % mlds_output_tag(Tag),
+ % io__write_string(", "),
+ % mlds_output_lval(Target),
+ % io__write_string(", "),
+ % io__write_int(ArgOffset),
+ % io__write_string(", "),
+ % { convert_to_c_type(ArgType, CType) },
+ % io__write_string(CType),
+ % io__write_string(") = "),
+ % mlds_output_unboxed_rval(ArgType, Arg),
+ % io__write_string(";\n"),
+ get_type_size(ArgType, NextArgSize),
+ mlds_output_unboxed_init_args(Args, ArgTypes, Context,
+ ArgOffset + NextArgSize, Target, Type, FuncInfo, Tag, Indent).
+
+:- pred get_type_size(mlds__type, int, io__state, io__state).
+:- mode get_type_size(in, out, di, uo) is det.
+
+get_type_size(ArgType, ArgSize) -->
+ globals__io_lookup_int_option(bits_per_byte, BitsPerByte),
+ globals__io_lookup_int_option(bits_per_char, BitsPerChar),
+ globals__io_lookup_int_option(bits_per_float, BitsPerFloat),
+ globals__io_lookup_int_option(bytes_per_word, BytesPerWord),
+ { ( ArgType = mercury_type(_ProgType, BuiltinType, _ExportedType) ->
+ ( BuiltinType = char_type ->
+ ArgSize = BitsPerChar // BitsPerByte
+ ; BuiltinType = float_type ->
+ ArgSize = BitsPerFloat // BitsPerByte
+ ;
+ ArgSize = BytesPerWord
+ )
+ ;
+ ArgSize = BytesPerWord
+ ) }.
%-----------------------------------------------------------------------------%
%
% Code to output expressions
@@ -2744,7 +2891,25 @@
:- pred mlds_output_lval(mlds__lval, io__state, io__state).
:- mode mlds_output_lval(in, di, uo) is det.
-mlds_output_lval(field(MaybeTag, Rval, offset(OffsetRval),
+mlds_output_lval(field(MaybeTag, Rval, byte_offset(OffsetInBytesRval),
+ FieldType, _ClassType)) -->
+ io__write_string("("),
+ ( { MaybeTag = yes(Tag) } ->
+ io__write_string("MR_hl_byte_field("),
+ mlds_output_tag(Tag),
+ io__write_string(", ")
+ ;
+ io__write_string("MR_hl_mask_byte_field("),
+ io__write_string("(MR_Word) ")
+ ),
+ mlds_output_rval(Rval),
+ io__write_string(", "),
+ mlds_output_rval(OffsetInBytesRval),
+ io__write_string(", "),
+ { convert_to_c_type(FieldType, CType) },
+ io__write_string(CType),
+ io__write_string("))").
+mlds_output_lval(field(MaybeTag, Rval, word_offset(OffsetInWordsRval),
FieldType, _ClassType)) -->
(
{ FieldType = mlds__generic_type
@@ -2767,7 +2932,7 @@
),
mlds_output_rval(Rval),
io__write_string(", "),
- mlds_output_rval(OffsetRval),
+ mlds_output_rval(OffsetInWordsRval),
io__write_string("))").
mlds_output_lval(field(MaybeTag, PtrRval, named_field(FieldName, CtorType),
_FieldType, PtrType)) -->
@@ -2804,6 +2969,27 @@
mlds_output_bracketed_rval(Rval).
mlds_output_lval(var(VarName, _VarType)) -->
mlds_output_var(VarName).
+
+:- pred convert_to_c_type(mlds__type, string).
+:- mode convert_to_c_type(in, out) is det.
+
+convert_to_c_type(Type, CTypeString) :-
+ ( Type = mercury_type(_ProgType, BuiltinType, _ExportedType) ->
+ ( BuiltinType = char_type ->
+ CTypeString = "MR_Char"
+ ; BuiltinType = float_type ->
+ CTypeString = "MR_Float"
+ ; BuiltinType = str_type ->
+ CTypeString = "MR_String"
+ ; BuiltinType = int_type ->
+ CTypeString = "MR_Integer"
+ ;
+ CTypeString = "MR_Word"
+ )
+ ;
+ CTypeString = "MR_Word"
+ ).
+
:- pred mlds_output_var(mlds__var, io__state, io__state).
:- mode mlds_output_var(in, di, uo) is det.
Index: compiler/mlds_to_csharp.m
===================================================================
RCS file: /home/mercury1/repository//mercury/compiler/mlds_to_csharp.m,v
retrieving revision 1.21
diff -u -r1.21 mlds_to_csharp.m
--- compiler/mlds_to_csharp.m 21 Jan 2002 04:39:18 -0000 1.21
+++ compiler/mlds_to_csharp.m 24 Feb 2002 08:55:37 -0000
@@ -399,12 +399,23 @@
{ FieldId = qual(_, FieldName) },
io__write_string(FieldName).
-write_csharp_lval(field(_, Rval, offset(OffSet), _, _)) -->
+ % XXX Field offsets in bytes have not yet been implemented for the
+ % C sharp backend, and this alternative is only to ensure the predicate
+ % is det.
+write_csharp_lval(field(_, Rval, byte_offset(OffSetInBytes), _, _)) -->
io__write_string("("),
write_csharp_rval(Rval),
io__write_string(")"),
io__write_string("["),
- write_csharp_rval(OffSet),
+ write_csharp_rval(OffSetInBytes),
+ io__write_string("]").
+
+write_csharp_lval(field(_, Rval, word_offset(OffSetInWords), _, _)) -->
+ io__write_string("("),
+ write_csharp_rval(Rval),
+ io__write_string(")"),
+ io__write_string("["),
+ write_csharp_rval(OffSetInWords),
io__write_string("]").
write_csharp_lval(mem_ref(Rval, _)) -->
Index: compiler/mlds_to_gcc.m
===================================================================
RCS file: /home/mercury1/repository//mercury/compiler/mlds_to_gcc.m,v
retrieving revision 1.63
diff -u -r1.63 mlds_to_gcc.m
--- compiler/mlds_to_gcc.m 18 Feb 2002 07:00:57 -0000 1.63
+++ compiler/mlds_to_gcc.m 26 Feb 2002 06:10:02 -0000
@@ -2733,10 +2733,15 @@
%
% Calculate the size that we're going to allocate.
%
- ( { MaybeSize = yes(SizeInWords) } ->
+ ( { MaybeSize = yes(Size) } ->
globals__io_lookup_int_option(bytes_per_word, BytesPerWord),
- { SizeOfWord = const(int_const(BytesPerWord)) },
- { SizeInBytes = binop((*), SizeInWords, SizeOfWord) }
+ (
+ { Size = bytes(SizeInBytes) }
+ ;
+ { Size = words(SizeInWords) },
+ { SizeOfWord = const(int_const(BytesPerWord)) },
+ { SizeInBytes = binop((*), SizeInWords, SizeOfWord) }
+ )
;
{ sorry(this_file, "new_object with unknown size") }
),
@@ -2832,15 +2837,45 @@
% Currently all fields of new_object instructions are
% represented as MR_Box, so we need to box them if necessary.
%
- { Lval = field(yes(Tag), lval(Target),
- offset(const(int_const(ArgNum))), mlds__generic_type, Type) },
- { Rval = unop(box(ArgType), Arg) },
+ % XXX Not sure if this is correct, ie whether it will work for unboxed
+ % object fields.
+ globals__io_lookup_bool_option(unboxed_object_fields, Unboxed),
+ ( { Unboxed = yes } ->
+ { Lval = field(yes(Tag), lval(Target),
+ byte_offset(const(int_const(ArgNum))),
+ mlds__generic_type, Type) },
+ { Rval = Arg },
+ determine_byte_offset(ArgType, NextArgOffset),
+ gen_init_args(Args, ArgTypes, Context, ArgNum + NextArgOffset,
+ Target, Type, Tag, DefnInfo)
+ ;
+ { Lval = field(yes(Tag), lval(Target),
+ word_offset(const(int_const(ArgNum))),
+ mlds__generic_type, Type) },
+ { Rval = unop(box(ArgType), Arg) },
+ gen_init_args(Args, ArgTypes, Context, ArgNum + 1, Target,
+ Type, Tag, DefnInfo)
+ ),
build_lval(Lval, DefnInfo, GCC_Lval),
build_rval(Rval, DefnInfo, GCC_Rval),
- gcc__gen_assign(GCC_Lval, GCC_Rval),
- gen_init_args(Args, ArgTypes, Context,
- ArgNum + 1, Target, Type, Tag, DefnInfo).
+ gcc__gen_assign(GCC_Lval, GCC_Rval).
+
+:- pred determine_byte_offset(mlds__type, int, io__state, io__state).
+:- mode determine_byte_offset(in, out, di, uo) is det.
+
+determine_byte_offset(ArgType, NextArgOffset) -->
+ globals__io_lookup_int_option(bits_per_byte, BitsPerByte),
+ ( { ArgType = mercury_type(_ProgType, float_type, _ExportedType) } ->
+ globals__io_lookup_int_option(bits_per_float, BitsPerFloat),
+ { NextArgOffset = BitsPerFloat // BitsPerByte }
+ ; { ArgType = mercury_type(_ProgType, char_type, _ExportedType) } ->
+ globals__io_lookup_int_option(bits_per_char, BitsPerChar),
+ { NextArgOffset = BitsPerChar // BitsPerByte }
+ ;
+ globals__io_lookup_int_option(bytes_per_word, BytesPerWord),
+ { NextArgOffset = BytesPerWord }
+ ).
%-----------------------------------------------------------------------------%
%
% Code to output expressions
@@ -2849,7 +2884,52 @@
:- pred build_lval(mlds__lval, defn_info, gcc__expr, io__state, io__state).
:- mode build_lval(in, in, out, di, uo) is det.
-build_lval(field(MaybeTag, Rval, offset(OffsetRval),
+build_lval(field(MaybeTag, Rval, byte_offset(OffsetInBytesRval),
+ FieldType, _ClassType), DefnInfo, GCC_FieldRef) -->
+ % sanity check (copied from mlds_to_c.m)
+ % Avangion - perhaps this should be changed as per mlds_to_c.m?
+ (
+ { FieldType = mlds__generic_type
+ ; FieldType = mlds__mercury_type(term__variable(_), _, _)
+ }
+ ->
+ []
+ ;
+ % The field type for field(_, _, offset(_), _, _) lvals
+ % must be something that maps to MR_Box.
+ { error("unexpected field type") }
+ ),
+
+ % generate the tagged pointer whose field we want to extract
+ build_rval(Rval, DefnInfo, GCC_TaggedPointer),
+
+ % subtract or mask out the tag
+ ( { MaybeTag = yes(Tag) } ->
+ gcc__build_int(Tag, GCC_Tag),
+ gcc__build_binop(gcc__minus_expr, gcc__ptr_type_node,
+ GCC_TaggedPointer, GCC_Tag, GCC_Pointer)
+ ;
+ globals__io_lookup_int_option(num_tag_bits, TagBits),
+ gcc__build_int(\ ((1 << TagBits) - 1), GCC_Mask),
+ gcc__build_binop(gcc__bit_and_expr, gcc__ptr_type_node,
+ GCC_TaggedPointer, GCC_Mask, GCC_Pointer)
+ ),
+
+ % add the appropriate offset
+ build_rval(OffsetInBytesRval, DefnInfo, GCC_OffsetInBytes),
+ gcc__build_binop(gcc__plus_expr, gcc__ptr_type_node,
+ GCC_Pointer, GCC_OffsetInBytes, GCC_FieldPointer0),
+
+ % cast the pointer to the right type (XXX is this necessary?)
+ build_type(FieldType, DefnInfo ^ global_info, GCC_FieldType),
+ gcc__build_pointer_type(GCC_FieldType, GCC_FieldPointerType),
+ gcc__convert_type(GCC_FieldPointer0, GCC_FieldPointerType,
+ GCC_FieldPointer),
+
+ % deference it
+ gcc__build_pointer_deref(GCC_FieldPointer, GCC_FieldRef).
+
+build_lval(field(MaybeTag, Rval, word_offset(OffsetInWordsRval),
FieldType, _ClassType), DefnInfo, GCC_FieldRef) -->
% sanity check (copied from mlds_to_c.m)
(
@@ -2880,7 +2960,7 @@
),
% add the appropriate offset
- build_rval(OffsetRval, DefnInfo, GCC_OffsetInWords),
+ build_rval(OffsetInWordsRval, DefnInfo, GCC_OffsetInWords),
globals__io_lookup_int_option(bytes_per_word, BytesPerWord),
gcc__build_int(BytesPerWord, GCC_BytesPerWord),
gcc__build_binop(gcc__mult_expr, 'MR_intptr_t',
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury1/repository//mercury/compiler/mlds_to_il.m,v
retrieving revision 1.105
diff -u -r1.105 mlds_to_il.m
--- compiler/mlds_to_il.m 27 Feb 2002 16:21:30 -0000 1.105
+++ compiler/mlds_to_il.m 28 Feb 2002 04:53:47 -0000
@@ -209,13 +209,15 @@
globals__io_lookup_bool_option(sign_assembly, SignAssembly,
IO4, IO5),
globals__io_lookup_bool_option(separate_assemblies, SeparateAssemblies,
- IO5, IO),
+ IO5, IO6),
IlInfo0 = il_info_init(ModuleName, AssemblyName, Imports,
ILDataRep, DebugIlAsm, VerifiableCode, ByRefTailCalls),
+ globals__io_get_globals(Globals, IO6, IO),
+
% Generate code for all the methods.
- list__map_foldl(mlds_defn_to_ilasm_decl, Defns, ILDecls,
+ list__map_foldl(mlds_defn_to_ilasm_decl(Globals), Defns, ILDecls,
IlInfo0, IlInfo),
ForeignLangs = IlInfo ^ file_foreign_langs,
@@ -465,7 +467,10 @@
:- func rename_field_id(field_id) = field_id.
-rename_field_id(offset(Rval)) = offset(rename_rval(Rval)).
+ % XXX Field offsets in bytes have not yet been implemented in the IL
+ % backend, and this alternative is only to ensure the function is det.
+rename_field_id(byte_offset(Rval)) = byte_offset(rename_rval(Rval)).
+rename_field_id(word_offset(Rval)) = word_offset(rename_rval(Rval)).
rename_field_id(named_field(Name, Type)) = named_field(Name, Type).
:- func rename_initializer(mlds__initializer) = mlds__initializer.
@@ -498,26 +503,27 @@
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-:- pred mlds_defn_to_ilasm_decl(mlds__defn::in, ilasm__decl::out,
+:- pred mlds_defn_to_ilasm_decl(globals::in, mlds__defn::in, ilasm__decl::out,
il_info::in, il_info::out) is det.
% IL supports top-level (i.e. "global") function definitions and
% data definitions, but they're not part of the CLS.
% Since they are not part of the CLS, we don't generate them,
% and so there's no need to handle them here.
-mlds_defn_to_ilasm_decl(defn(_Name, _Context, _Flags, data(_Type, _Init, _GC)),
- _Decl, Info, Info) :-
+mlds_defn_to_ilasm_decl(_Globals, defn(_Name, _Context, _Flags, data(_Type,
+ _Init, _GC)), _Decl, Info, Info) :-
sorry(this_file, "top level data definition!").
-mlds_defn_to_ilasm_decl(defn(_Name, _Context, _Flags,
+mlds_defn_to_ilasm_decl(_Globals, defn(_Name, _Context, _Flags,
function(_MaybePredProcId, _Params, _MaybeStmts, _Attrs)),
_Decl, Info, Info) :-
sorry(this_file, "top level function definition!").
-mlds_defn_to_ilasm_decl(defn(Name, Context, Flags0, class(ClassDefn)),
+mlds_defn_to_ilasm_decl(Globals, defn(Name, Context, Flags0, class(ClassDefn)),
Decl, Info0, Info) :-
il_info_new_class(ClassDefn, Info0, Info1),
- generate_class_body(Name, Context, ClassDefn, ClassName, EntityName,
- Extends, Interfaces, MethodsAndFieldsAndCtors, Info1, Info2),
+ generate_class_body(Globals, Name, Context, ClassDefn, ClassName,
+ EntityName, Extends, Interfaces, MethodsAndFieldsAndCtors,
+ Info1, Info2),
% Only the wrapper class needs to have the
% initialization instructions executed by the class
@@ -557,13 +563,13 @@
Decl = class(decl_flags_to_classattrs(Flags), EntityName, Extends,
Interfaces, MethodDecls).
-:- pred generate_class_body(mlds__entity_name::in, mlds__context::in,
- mlds__class_defn::in,
+:- pred generate_class_body(globals::in, mlds__entity_name::in,
+ mlds__context::in, mlds__class_defn::in,
ilds__class_name::out, ilds__id::out, extends::out,
implements::out, list(class_member)::out,
il_info::in, il_info::out) is det.
-generate_class_body(Name, Context, ClassDefn,
+generate_class_body(Globals, Name, Context, ClassDefn,
ClassName, EntityName, Extends, Interfaces, ClassMembers,
Info0, Info) :-
EntityName = entity_name_to_ilds_id(Name),
@@ -574,10 +580,10 @@
Interfaces = implements(
list__map(interface_id_to_class_name, Implements)),
ClassName = class_name(Info0 ^ module_name, EntityName),
- list__map_foldl(generate_method(ClassName, no), Members,
+ list__map_foldl(generate_method(Globals, ClassName, no), Members,
MethodsAndFields, Info0, Info1),
Ctors = maybe_add_empty_ctor(Ctors0, Kind, Context),
- list__map_foldl(generate_method(ClassName, yes(Parent)), Ctors,
+ list__map_foldl(generate_method(Globals, ClassName, yes(Parent)), Ctors,
IlCtors, Info1, Info),
ClassMembers = IlCtors ++ MethodsAndFields.
@@ -797,11 +803,11 @@
%-----------------------------------------------------------------------------%
-:- pred generate_method(ilds__class_name::in, maybe(ilds__class_name)::in,
- mlds__defn::in, class_member::out,
+:- pred generate_method(globals::in, ilds__class_name::in,
+ maybe(ilds__class_name)::in, mlds__defn::in, class_member::out,
il_info::in, il_info::out) is det.
-generate_method(ClassName, _, defn(Name, Context, Flags, Entity),
+generate_method(Globals, ClassName, _, defn(Name, Context, Flags, Entity),
ClassMember) -->
{ Entity = data(Type, DataInitializer, _GC_TraceCode) },
@@ -815,8 +821,8 @@
% and instructions to initialize it.
% See the comments about class constructors to
% find out why we do this.
- data_initializer_to_instrs(DataInitializer, Type, AllocInstrsTree,
- InitInstrTree),
+ data_initializer_to_instrs(Globals, DataInitializer, Type,
+ AllocInstrsTree, InitInstrTree),
% Make a field reference for the field
DataRep =^ il_data_rep,
@@ -895,7 +901,8 @@
{ ClassMember = field(Attrs, ILType, FieldName,
MaybeOffset, Initializer) }.
-generate_method(_, IsCons, defn(Name, Context, Flags, Entity), ClassMember) -->
+generate_method(Globals, _, IsCons, defn(Name, Context, Flags, Entity),
+ ClassMember) -->
{ Entity = function(_MaybePredProcId, Params, MaybeStatement,
Attributes) },
@@ -940,13 +947,13 @@
% Generate the code of the statement.
(
{ MaybeStatement = defined_here(Statement) },
- statement_to_il(Statement, InstrsTree1)
+ statement_to_il(Globals, Statement, InstrsTree1)
;
{ MaybeStatement = external },
% If there is no function body, generate
% forwarding code instead. This can happen with
% :- external
- atomic_statement_to_il(inline_target_code(lang_C, []),
+ atomic_statement_to_il(Globals, inline_target_code(lang_C, []),
InstrsTree0),
% The code might reference locals...
@@ -1169,10 +1176,11 @@
{ ClassMember = ilasm__method(methodhead(Attrs, MemberName,
ILSignature, []), MethodContents)}.
-generate_method(_, _, defn(Name, Context, Flags, Entity), ClassMember) -->
+generate_method(Globals, _, _, defn(Name, Context, Flags, Entity),
+ ClassMember) -->
{ Entity = class(ClassDefn) },
- generate_class_body(Name, Context, ClassDefn, _ClassName, EntityName,
- Extends, Interfaces, ClassMembers),
+ generate_class_body(Globals, Name, Context, ClassDefn, _ClassName,
+ EntityName, Extends, Interfaces, ClassMembers),
{ ClassMember = nested_class(decl_flags_to_nestedclassattrs(Flags),
EntityName, Extends, Interfaces, ClassMembers) }.
@@ -1307,10 +1315,10 @@
% Generate initializer code from an MLDS defn. We are only expecting
% data defns at this point (local vars), not functions or classes.
-:- pred generate_defn_initializer(mlds__defn, instr_tree, instr_tree,
+:- pred generate_defn_initializer(globals, mlds__defn, instr_tree, instr_tree,
il_info, il_info).
-:- mode generate_defn_initializer(in, in, out, in, out) is det.
-generate_defn_initializer(defn(Name, Context, _DeclFlags, Entity),
+:- mode generate_defn_initializer(in, in, in, out, in, out) is det.
+generate_defn_initializer(Globals, defn(Name, Context, _DeclFlags, Entity),
Tree0, Tree) -->
(
{ Name = data(DataName) },
@@ -1323,7 +1331,7 @@
il_info_get_module_name(ModuleName),
{ Lval = var(qual(ModuleName, VarName),
MLDSType) },
- get_load_store_lval_instrs(Lval,
+ get_load_store_lval_instrs(Globals, Lval,
LoadMemRefInstrs, StoreLvalInstrs),
{ NameString = mangle_mlds_var_name(VarName) }
;
@@ -1332,8 +1340,8 @@
{ StoreLvalInstrs = node([]) },
{ NameString = "unknown" }
),
- data_initializer_to_instrs(Initializer, MLDSType,
- AllocInstrs, InitInstrs),
+ data_initializer_to_instrs(Globals, Initializer,
+ MLDSType, AllocInstrs, InitInstrs),
{ string__append("initializer for ", NameString,
Comment) },
{ Tree = tree__list([
@@ -1353,10 +1361,11 @@
% initialize this value, leave it on the stack.
% XXX the code generator doesn't box these values
% we need to look ahead at them and box them appropriately.
-:- pred data_initializer_to_instrs(mlds__initializer::in, mlds__type::in,
- instr_tree::out, instr_tree::out, il_info::in, il_info::out) is det.
-data_initializer_to_instrs(init_obj(Rval), _Type, node([]), InitInstrs) -->
- load(Rval, InitInstrs).
+:- pred data_initializer_to_instrs(globals::in, mlds__initializer::in,
+ mlds__type::in, instr_tree::out, instr_tree::out, il_info::in,
+ il_info::out) is det.
+data_initializer_to_instrs(Globals, init_obj(Rval), _Type, node([]), InitInstrs) -->
+ load(Globals, Rval, InitInstrs).
% MLDS structures initializers are assumed to be initialized like
% structures in C, which means nested elements are actually laid out
@@ -1366,19 +1375,19 @@
% (this may have to be re-visited if used to initialise high-level
% data).
-data_initializer_to_instrs(init_struct(InitList0), Type,
+data_initializer_to_instrs(Globals, init_struct(InitList0), Type,
AllocInstrs, InitInstrs) -->
{ InitList = flatten_inits(InitList0) },
- data_initializer_to_instrs(init_array(InitList), Type,
+ data_initializer_to_instrs(Globals, init_array(InitList), Type,
AllocInstrs, InitInstrs).
% Put the array allocation in AllocInstrs.
% For sub-initializations, we don't worry about keeping AllocInstrs
% and InitInstrs apart, since we are only interested in top level
% allocations.
-data_initializer_to_instrs(init_array(InitList), Type,
+data_initializer_to_instrs(Globals, init_array(InitList), Type,
AllocInstrs, InitInstrs) -->
%
@@ -1424,7 +1433,7 @@
;
{ Init = Init0 }
),
- data_initializer_to_instrs(Init, ElemType,
+ data_initializer_to_instrs(Globals, Init, ElemType,
ATree1, ITree1),
{ Tree = tree(tree(Tree0, node(
[dup, ldc(int32, i(X0))])),
@@ -1433,7 +1442,8 @@
))) }
) },
list__foldl2(AddInitializer, InitList, 0 - empty, _ - InitInstrs).
-data_initializer_to_instrs(no_initializer, _, node([]), node([])) --> [].
+data_initializer_to_instrs(_Globals, no_initializer, _, node([]), node([]))
+ --> [].
% If we are initializing an array or struct, we need to box
% all the things inside it.
@@ -1475,26 +1485,27 @@
% Convert basic MLDS statements into IL.
%
-:- pred statements_to_il(list(mlds__statement), instr_tree, il_info, il_info).
-:- mode statements_to_il(in, out, in, out) is det.
-statements_to_il([], empty) --> [].
-statements_to_il([ S | Statements], tree(Instrs0, Instrs1)) -->
- statement_to_il(S, Instrs0),
- statements_to_il(Statements, Instrs1).
+:- pred statements_to_il(globals, list(mlds__statement), instr_tree, il_info,
+ il_info).
+:- mode statements_to_il(in, in, out, in, out) is det.
+statements_to_il(_Globals, [], empty) --> [].
+statements_to_il(Globals, [ S | Statements], tree(Instrs0, Instrs1)) -->
+ statement_to_il(Globals, S, Instrs0),
+ statements_to_il(Globals, Statements, Instrs1).
-:- pred statement_to_il(mlds__statement, instr_tree, il_info, il_info).
-:- mode statement_to_il(in, out, in, out) is det.
+:- pred statement_to_il(globals, mlds__statement, instr_tree, il_info, il_info).
+:- mode statement_to_il(in, in, out, in, out) is det.
-statement_to_il(statement(block(Defns, Statements), Context),
+statement_to_il(Globals, statement(block(Defns, Statements), Context),
Instrs) -->
il_info_get_module_name(ModuleName),
il_info_get_next_block_id(BlockId),
{ list__map(defn_to_local(ModuleName), Defns, Locals) },
il_info_add_locals(Locals),
- list__foldl2(generate_defn_initializer, Defns, empty,
+ list__foldl2(generate_defn_initializer(Globals), Defns, empty,
InitInstrsTree),
- statements_to_il(Statements, BlockInstrs),
+ statements_to_il(Globals, Statements, BlockInstrs),
DataRep =^ il_data_rep,
{ list__map((pred((K - V)::in, (K - W)::out) is det :-
W = mlds_type_to_ilds_type(DataRep, V)), Locals, ILLocals) },
@@ -1509,12 +1520,12 @@
]) },
il_info_remove_locals(Locals).
-statement_to_il(statement(atomic(Atomic), Context), Instrs) -->
- atomic_statement_to_il(Atomic, AtomicInstrs),
+statement_to_il(Globals, statement(atomic(Atomic), Context), Instrs) -->
+ atomic_statement_to_il(Globals, Atomic, AtomicInstrs),
{ Instrs = tree(context_node(Context), AtomicInstrs) }.
-statement_to_il(statement(call(Sig, Function, _This, Args, Returns, IsTail),
- Context), Instrs) -->
+statement_to_il(Globals, statement(call(Sig, Function, _This, Args, Returns,
+ IsTail), Context), Instrs) -->
VerifiableCode =^ verifiable_code,
ByRefTailCalls =^ il_byref_tailcalls,
DataRep =^ il_data_rep,
@@ -1557,10 +1568,10 @@
% into the memory reference after the call.
{ TailCallInstrs = [] },
{ RetInstrs = [] },
- get_all_load_store_lval_instrs(Returns,
+ get_all_load_store_lval_instrs(Globals, Returns,
LoadMemRefInstrs, ReturnsStoredInstrs)
),
- list__map_foldl(load, Args, ArgsLoadInstrsTrees),
+ list__map_foldl(load(Globals), Args, ArgsLoadInstrsTrees),
{ ArgsLoadInstrs = tree__list(ArgsLoadInstrsTrees) },
( { Function = const(_) } ->
{ FunctionLoadInstrs = empty },
@@ -1568,7 +1579,7 @@
{ Instrs0 = [call(methoddef(call_conv(no, default),
ReturnParam, MemberName, TypeParams))] }
;
- load(Function, FunctionLoadInstrs),
+ load(Globals, Function, FunctionLoadInstrs),
{ list__length(TypeParams, Length) },
{ list__duplicate(Length, no, NoList) },
{ assoc_list__from_corresponding_lists(
@@ -1588,12 +1599,12 @@
ReturnsStoredInstrs
]) }.
-statement_to_il(statement(if_then_else(Condition, ThenCase, ElseCase),
+statement_to_il(Globals, statement(if_then_else(Condition, ThenCase, ElseCase),
Context), Instrs) -->
- generate_condition(Condition, ConditionInstrs, ElseLabel),
+ generate_condition(Globals, Condition, ConditionInstrs, ElseLabel),
il_info_make_next_label(DoneLabel),
- statement_to_il(ThenCase, ThenInstrs),
- maybe_map_fold(statement_to_il, ElseCase, empty, ElseInstrs),
+ statement_to_il(Globals, ThenCase, ThenInstrs),
+ maybe_map_fold(statement_to_il(Globals), ElseCase, empty, ElseInstrs),
{ Instrs = tree__list([
context_node(Context),
comment_node("if then else"),
@@ -1608,18 +1619,18 @@
instr_node(label(DoneLabel))
]) }.
-statement_to_il(statement(switch(_Type, _Val, _Range, _Cases, _Default),
- _Context), _Instrs) -->
+statement_to_il(_Globals, statement(switch(_Type, _Val, _Range, _Cases,
+ _Default), _Context), _Instrs) -->
% The IL back-end only supports computed_gotos and if-then-else chains;
% the MLDS code generator should either avoid generating MLDS switches,
% or should transform them into computed_gotos or if-then-else chains.
{ error("mlds_to_il.m: `switch' not supported") }.
-statement_to_il(statement(while(Condition, Body, AtLeastOnce),
+statement_to_il(Globals, statement(while(Condition, Body, AtLeastOnce),
Context), Instrs) -->
- generate_condition(Condition, ConditionInstrs, EndLabel),
+ generate_condition(Globals, Condition, ConditionInstrs, EndLabel),
il_info_make_next_label(StartLabel),
- statement_to_il(Body, BodyInstrs),
+ statement_to_il(Globals, Body, BodyInstrs),
{ AtLeastOnce = no,
Instrs = tree__list([
context_node(Context),
@@ -1645,9 +1656,9 @@
}.
-statement_to_il(statement(return(Rvals), Context), Instrs) -->
+statement_to_il(Globals, statement(return(Rvals), Context), Instrs) -->
( { Rvals = [Rval] } ->
- load(Rval, LoadInstrs),
+ load(Globals, Rval, LoadInstrs),
{ Instrs = tree__list([
context_node(Context),
LoadInstrs,
@@ -1659,7 +1670,7 @@
{ sorry(this_file, "multiple return values") }
).
-statement_to_il(statement(label(Label), Context), Instrs) -->
+statement_to_il(_Globals, statement(label(Label), Context), Instrs) -->
{ string__format("label %s", [s(Label)], Comment) },
{ Instrs = node([
comment(Comment),
@@ -1667,7 +1678,8 @@
label(Label)
]) }.
-statement_to_il(statement(goto(label(Label)), Context), Instrs) -->
+
+statement_to_il(_Globals, statement(goto(label(Label)), Context), Instrs) -->
{ string__format("goto %s", [s(Label)], Comment) },
{ Instrs = node([
comment(Comment),
@@ -1675,14 +1687,13 @@
br(label_target(Label))
]) }.
-statement_to_il(statement(goto(break), _Context), _Instrs) -->
+statement_to_il(_Globals, statement(goto(break), _Context), _Instrs) -->
{ sorry(this_file, "break") }.
-statement_to_il(statement(goto(continue), _Context), _Instrs) -->
+statement_to_il(_Globals, statement(goto(continue), _Context), _Instrs) -->
{ sorry(this_file, "continue") }.
-statement_to_il(statement(do_commit(_Ref), Context), Instrs) -->
-
+statement_to_il(_Globals, statement(do_commit(_Ref), Context), Instrs) -->
% For commits, we use exception handling.
%
% For a do_commit instruction, we generate code equivalent
@@ -1705,8 +1716,8 @@
instr_node(throw)
]) }.
-statement_to_il(statement(try_commit(_Ref, GoalToTry, CommitHandlerGoal),
- Context), Instrs) -->
+statement_to_il(Globals, statement(try_commit(_Ref, GoalToTry,
+ CommitHandlerGoal), Context), Instrs) -->
% For commits, we use exception handling.
%
@@ -1725,9 +1736,9 @@
%
il_info_get_next_block_id(TryBlockId),
- statement_to_il(GoalToTry, GoalInstrsTree),
+ statement_to_il(Globals, GoalToTry, GoalInstrsTree),
il_info_get_next_block_id(CatchBlockId),
- statement_to_il(CommitHandlerGoal, HandlerInstrsTree),
+ statement_to_il(Globals, CommitHandlerGoal, HandlerInstrsTree),
il_info_make_next_label(DoneLabel),
{ ClassName = il_commit_class_name },
@@ -1750,9 +1761,9 @@
]) }.
-statement_to_il(statement(computed_goto(Rval, MLDSLabels), Context),
+statement_to_il(Globals, statement(computed_goto(Rval, MLDSLabels), Context),
Instrs) -->
- load(Rval, RvalLoadInstrs),
+ load(Globals, Rval, RvalLoadInstrs),
{ Targets = list__map(func(L) = label_target(L), MLDSLabels) },
{ Instrs = tree__list([
context_node(Context),
@@ -1763,21 +1774,21 @@
-:- pred atomic_statement_to_il(mlds__atomic_statement, instr_tree,
+:- pred atomic_statement_to_il(globals, mlds__atomic_statement, instr_tree,
il_info, il_info).
-:- mode atomic_statement_to_il(in, out, in, out) is det.
+:- mode atomic_statement_to_il(in, in, out, in, out) is det.
-atomic_statement_to_il(gc_check, node(Instrs)) -->
+atomic_statement_to_il(_Globals, gc_check, node(Instrs)) -->
{ Instrs = [comment(
"gc check -- not relevant for this backend")] }.
-atomic_statement_to_il(mark_hp(_), node(Instrs)) -->
+atomic_statement_to_il(_Globals, mark_hp(_), node(Instrs)) -->
{ Instrs = [comment(
"mark hp -- not relevant for this backend")] }.
-atomic_statement_to_il(restore_hp(_), node(Instrs)) -->
+atomic_statement_to_il(_Globals, restore_hp(_), node(Instrs)) -->
{ Instrs = [comment(
"restore hp -- not relevant for this backend")] }.
-atomic_statement_to_il(outline_foreign_proc(Lang, ReturnLvals, _Code),
+atomic_statement_to_il(Globals, outline_foreign_proc(Lang, ReturnLvals, _Code),
Instrs) -->
il_info_get_module_name(ModuleName),
( no =^ method_foreign_lang ->
@@ -1805,7 +1816,7 @@
stloc(name("SUCCESS_INDICATOR")))
}
; { ReturnLvals = [ReturnLval] } ->
- get_load_store_lval_instrs(ReturnLval,
+ get_load_store_lval_instrs(Globals, ReturnLval,
LoadInstrs, StoreInstrs)
;
{ sorry(this_file, "multiple return values") }
@@ -1831,7 +1842,7 @@
).
% XXX we assume lang_C is MC++
-atomic_statement_to_il(inline_target_code(lang_C, _Code), Instrs) -->
+atomic_statement_to_il(_Globals, inline_target_code(lang_C, _Code), Instrs) -->
il_info_get_module_name(ModuleName),
( no =^ method_foreign_lang ->
% XXX we hardcode managed C++ here
@@ -1869,39 +1880,42 @@
;
{ Instrs = comment_node("inline target code -- already called") }
).
-atomic_statement_to_il(inline_target_code(lang_il, Code), Instrs) -->
+atomic_statement_to_il(_Globals, inline_target_code(lang_il, Code), Instrs) -->
{ Instrs = inline_code_to_il_asm(Code) }.
-atomic_statement_to_il(inline_target_code(lang_java_bytecode, _), _) -->
+atomic_statement_to_il(_Globals, inline_target_code(lang_java_bytecode, _), _)
+ -->
{ unexpected(this_file, "lang_java_bytecode") }.
-atomic_statement_to_il(inline_target_code(lang_java_asm, _), _) -->
+atomic_statement_to_il(_Globals, inline_target_code(lang_java_asm, _), _) -->
{ unexpected(this_file, "lang_java_asm") }.
-atomic_statement_to_il(inline_target_code(lang_asm, _), _) -->
+atomic_statement_to_il(_Globals, inline_target_code(lang_asm, _), _) -->
{ unexpected(this_file, "lang_asm") }.
-atomic_statement_to_il(inline_target_code(lang_GNU_C, _), _) -->
+atomic_statement_to_il(_Globals, inline_target_code(lang_GNU_C, _), _) -->
{ unexpected(this_file, "lang_GNU_C") }.
-atomic_statement_to_il(inline_target_code(lang_C_minus_minus, _), _) -->
+atomic_statement_to_il(_Globals, inline_target_code(lang_C_minus_minus, _), _)
+ -->
{ unexpected(this_file, "lang_C_minus_minus") }.
-atomic_statement_to_il(trail_op(_), node(Instrs)) -->
+atomic_statement_to_il(_Globals, trail_op(_), node(Instrs)) -->
{ Instrs = [comment(
"... some trail operation ... (unimplemented)")] }.
-atomic_statement_to_il(assign(Lval, Rval), Instrs) -->
+atomic_statement_to_il(Globals, assign(Lval, Rval), Instrs) -->
% do assignments by loading the rval and storing
% to the lval
- load(Rval, LoadRvalInstrs),
- get_load_store_lval_instrs(Lval, LoadMemRefInstrs, StoreLvalInstrs),
+ load(Globals, Rval, LoadRvalInstrs),
+ get_load_store_lval_instrs(Globals, Lval, LoadMemRefInstrs,
+ StoreLvalInstrs),
{ Instrs = tree__list([
comment_node("assign"),
LoadMemRefInstrs,
LoadRvalInstrs,
StoreLvalInstrs
]) }.
-atomic_statement_to_il(comment(Comment), Instrs) -->
+atomic_statement_to_il(_Globals, comment(Comment), Instrs) -->
{ Instrs = node([comment(Comment)]) }.
-atomic_statement_to_il(delete_object(Target), Instrs) -->
+atomic_statement_to_il(Globals, delete_object(Target), Instrs) -->
% XXX we assume the code generator knows what it is
% doing and is only going to delete real objects (e.g.
% reference types). It would perhaps be prudent to
@@ -1911,11 +1925,11 @@
% We implement delete_object by storing null in the
% lval, which hopefully gives the garbage collector a good
% solid hint that this storage is no longer required.
- get_load_store_lval_instrs(Target, LoadInstrs, StoreInstrs),
+ get_load_store_lval_instrs(Globals, Target, LoadInstrs, StoreInstrs),
{ Instrs = tree__list([LoadInstrs, instr_node(ldnull), StoreInstrs]) }.
-atomic_statement_to_il(new_object(Target, _MaybeTag, HasSecTag, Type, Size,
- MaybeCtorName, Args0, ArgTypes0), Instrs) -->
+atomic_statement_to_il(Globals, new_object(Target, _MaybeTag, HasSecTag, Type,
+ Size, MaybeCtorName, Args0, ArgTypes0), Instrs) -->
DataRep =^ il_data_rep,
(
{
@@ -1967,9 +1981,9 @@
},
{ ILArgTypes = list__map(mlds_type_to_ilds_type(DataRep),
ArgTypes) },
- list__map_foldl(load, Args, ArgsLoadInstrsTrees),
+ list__map_foldl(load(Globals), Args, ArgsLoadInstrsTrees),
{ ArgsLoadInstrs = tree__list(ArgsLoadInstrsTrees) },
- get_load_store_lval_instrs(Target, LoadMemRefInstrs,
+ get_load_store_lval_instrs(Globals, Target, LoadMemRefInstrs,
StoreLvalInstrs),
{ CallCtor = newobj_constructor(ClassName, ILArgTypes) },
{ Instrs = tree__list([
@@ -2013,8 +2027,8 @@
Arg::out) is det :-
Arg0 = Index - S0,
I0 = instr_node(dup),
- load(const(int_const(Index)), I1, S0, S1),
- load(Rval, I2, S1, S),
+ load(Globals, const(int_const(Index)), I1, S0, S1),
+ load(Globals, Rval, I2, S1, S),
I3 = instr_node(stelem(il_generic_simple_type)),
I = tree__list([I0, I1, I2, I3]),
Arg = (Index + 1) - S
@@ -2027,17 +2041,23 @@
% Get the instructions to load and store the
% target.
- get_load_store_lval_instrs(Target, LoadMemRefInstrs,
+ get_load_store_lval_instrs(Globals, Target, LoadMemRefInstrs,
StoreLvalInstrs),
- { Size = yes(SizeInWordsRval0) ->
- SizeInWordsRval = SizeInWordsRval0
+ ( { Size = yes(SizeRval) } ->
+ (
+ { SizeRval = words(SizeInWordsRval) },
+ load(Globals, SizeInWordsRval, LoadSizeInstrs)
+ ;
+ { SizeRval = bytes(SizeInBytesRval) },
+ load(Globals, SizeInBytesRval, LoadSizeInstrs)
+ )
+
;
% XXX do we need to handle this case?
% I think it's needed for --high-level-data
- error("unknown size in MLDS new_object")
- },
- load(SizeInWordsRval, LoadSizeInstrs),
+ { error("unknown size in MLDS new_object") }
+ ),
{ Instrs = tree__list([
LoadMemRefInstrs,
@@ -2092,15 +2112,17 @@
get_max_stack_attribute([X | _Xs]) = yes(X) :- X = max_stack_size(_).
-:- pred get_all_load_store_lval_instrs(list(lval), instr_tree, instr_tree,
- il_info, il_info).
-:- mode get_all_load_store_lval_instrs(in, out, out, in, out) is det.
-get_all_load_store_lval_instrs([], empty, empty) --> [].
-get_all_load_store_lval_instrs([Lval | Lvals],
+:- pred get_all_load_store_lval_instrs(globals, list(lval), instr_tree,
+ instr_tree, il_info, il_info).
+:- mode get_all_load_store_lval_instrs(in, in, out, out, in, out) is det.
+get_all_load_store_lval_instrs(_Globals, [], empty, empty) --> [].
+get_all_load_store_lval_instrs(Globals, [Lval | Lvals],
tree(LoadMemRefNode, LoadMemRefTree),
tree(StoreLvalNode, StoreLvalTree)) -->
- get_load_store_lval_instrs(Lval, LoadMemRefNode, StoreLvalNode),
- get_all_load_store_lval_instrs(Lvals, LoadMemRefTree, StoreLvalTree).
+ get_load_store_lval_instrs(Globals, Lval, LoadMemRefNode,
+ StoreLvalNode),
+ get_all_load_store_lval_instrs(Globals, Lvals, LoadMemRefTree,
+ StoreLvalTree).
% Some lvals need to be loaded before you load the rval.
% XXX It would be much better if this took the lval and the rval and
@@ -2109,14 +2131,14 @@
% the rval in between.
% The predicate `store' should probably take the lval and the
% rval and do all of this at once.
-:- pred get_load_store_lval_instrs(lval, instr_tree, instr_tree, il_info,
- il_info).
-:- mode get_load_store_lval_instrs(in, out, out, in, out) is det.
-get_load_store_lval_instrs(Lval, LoadMemRefInstrs,
+:- pred get_load_store_lval_instrs(globals, lval, instr_tree, instr_tree,
+ il_info, il_info).
+:- mode get_load_store_lval_instrs(in, in, out, out, in, out) is det.
+get_load_store_lval_instrs(Globals, Lval, LoadMemRefInstrs,
StoreLvalInstrs) -->
DataRep =^ il_data_rep,
( { Lval = mem_ref(Rval0, MLDS_Type) } ->
- load(Rval0, LoadMemRefInstrs),
+ load(Globals, Rval0, LoadMemRefInstrs),
{ SimpleType = mlds_type_to_ilds_simple_type(DataRep,
MLDS_Type) },
{ StoreLvalInstrs = instr_node(stind(SimpleType)) }
@@ -2124,14 +2146,14 @@
ClassType) } ->
{ get_fieldref(DataRep, FieldNum, FieldType, ClassType,
FieldRef, CastClassInstrs) },
- load(FieldRval, LoadMemRefInstrs0),
+ load(Globals, FieldRval, LoadMemRefInstrs0),
{ LoadMemRefInstrs = tree__list([
LoadMemRefInstrs0,
CastClassInstrs]) },
{ StoreLvalInstrs = instr_node(stfld(FieldRef)) }
;
{ LoadMemRefInstrs = empty },
- store(Lval, StoreLvalInstrs)
+ store(Globals, Lval, StoreLvalInstrs)
).
%-----------------------------------------------------------------------------%
@@ -2145,10 +2167,10 @@
% sandwich the calculation of the rval in between the two.
%
-:- pred load(mlds__rval, instr_tree, il_info, il_info) is det.
-:- mode load(in, out, in, out) is det.
+:- pred load(globals, mlds__rval, instr_tree, il_info, il_info) is det.
+:- mode load(in, in, out, in, out) is det.
-load(lval(Lval), Instrs) -->
+load(Globals, lval(Lval), Instrs) -->
DataRep =^ il_data_rep,
( { Lval = var(Var, VarType) },
{ mangle_mlds_var(Var, MangledVarStr) },
@@ -2164,18 +2186,37 @@
Instrs = instr_node(ldsfld(FieldRef))
}
; { Lval = field(_MaybeTag, Rval, FieldNum, FieldType, ClassType) },
- load(Rval, RvalLoadInstrs),
- ( { FieldNum = offset(OffSet) } ->
- { SimpleFieldType = mlds_type_to_ilds_simple_type(
- DataRep, FieldType) },
- load(OffSet, OffSetLoadInstrs),
- { CastClassInstrs = empty },
- { LoadInstruction = ldelem(SimpleFieldType) }
- ;
- { get_fieldref(DataRep, FieldNum, FieldType, ClassType,
- FieldRef, CastClassInstrs) },
- { LoadInstruction = ldfld(FieldRef) },
- { OffSetLoadInstrs = empty }
+ load(Globals, Rval, RvalLoadInstrs),
+ { globals__lookup_bool_option(Globals, unboxed_object_fields,
+ Unboxed) },
+ ( { Unboxed = yes } ->
+ ( { FieldNum = byte_offset(OffSetInBytes) } ->
+ { SimpleFieldType =
+ mlds_type_to_ilds_simple_type( DataRep,
+ FieldType) },
+ load(Globals, OffSetInBytes, OffSetLoadInstrs),
+ { CastClassInstrs = empty },
+ { LoadInstruction = ldelem(SimpleFieldType) }
+ ;
+ { get_fieldref(DataRep, FieldNum, FieldType,
+ ClassType, FieldRef, CastClassInstrs) },
+ { LoadInstruction = ldfld(FieldRef) },
+ { OffSetLoadInstrs = empty }
+ )
+ ;
+ ( { FieldNum = word_offset(OffSetInWords) } ->
+ { SimpleFieldType =
+ mlds_type_to_ilds_simple_type( DataRep,
+ FieldType) },
+ load(Globals, OffSetInWords, OffSetLoadInstrs),
+ { CastClassInstrs = empty },
+ { LoadInstruction = ldelem(SimpleFieldType) }
+ ;
+ { get_fieldref(DataRep, FieldNum, FieldType,
+ ClassType, FieldRef, CastClassInstrs) },
+ { LoadInstruction = ldfld(FieldRef) },
+ { OffSetLoadInstrs = empty }
+ )
),
{ Instrs = tree__list([
RvalLoadInstrs,
@@ -2186,19 +2227,19 @@
; { Lval = mem_ref(Rval, MLDS_Type) },
{ SimpleType = mlds_type_to_ilds_simple_type(DataRep,
MLDS_Type) },
- load(Rval, RvalLoadInstrs),
+ load(Globals, Rval, RvalLoadInstrs),
{ Instrs = tree__list([
RvalLoadInstrs,
instr_node(ldind(SimpleType))
]) }
).
-load(mkword(_Tag, _Rval), Instrs) -->
+load(_Globals, mkword(_Tag, _Rval), Instrs) -->
{ Instrs = comment_node("unimplemented load rval mkword") }.
% XXX check these, what should we do about multi strings,
% characters, etc.
-load(const(Const), Instrs) -->
+load(_Globals, const(Const), Instrs) -->
DataRep =^ il_data_rep,
% true and false are just the integers 1 and 0
{ Const = true,
@@ -2225,18 +2266,18 @@
Instrs = instr_node(ldnull)
}.
-load(unop(Unop, Rval), Instrs) -->
- load(Rval, RvalLoadInstrs),
- unaryop_to_il(Unop, Rval, UnOpInstrs),
+load(Globals, unop(Unop, Rval), Instrs) -->
+ load(Globals, Rval, RvalLoadInstrs),
+ unaryop_to_il(Globals, Unop, Rval, UnOpInstrs),
{ Instrs = tree__list([RvalLoadInstrs, UnOpInstrs]) }.
-load(binop(BinOp, R1, R2), Instrs) -->
- load(R1, R1LoadInstrs),
- load(R2, R2LoadInstrs),
+load(Globals, binop(BinOp, R1, R2), Instrs) -->
+ load(Globals, R1, R1LoadInstrs),
+ load(Globals, R2, R2LoadInstrs),
binaryop_to_il(BinOp, BinaryOpInstrs),
{ Instrs = tree__list([R1LoadInstrs, R2LoadInstrs, BinaryOpInstrs]) }.
-load(mem_addr(Lval), Instrs) -->
+load(Globals, mem_addr(Lval), Instrs) -->
DataRep =^ il_data_rep,
( { Lval = var(Var, VarType) },
{ mangle_mlds_var(Var, MangledVarStr) },
@@ -2254,7 +2295,7 @@
; { Lval = field(_MaybeTag, Rval, FieldNum, FieldType, ClassType) },
{ get_fieldref(DataRep, FieldNum, FieldType, ClassType,
FieldRef, CastClassInstrs) },
- load(Rval, RvalLoadInstrs),
+ load(Globals, Rval, RvalLoadInstrs),
{ Instrs = tree__list([
RvalLoadInstrs,
CastClassInstrs,
@@ -2265,28 +2306,29 @@
{ Instrs = throw_unimplemented("load mem_addr lval mem_ref") }
).
-load(self(_), tree__list([instr_node(ldarg(index(0)))])) --> [].
+load(_Globals, self(_), tree__list([instr_node(ldarg(index(0)))])) --> [].
-:- pred store(mlds__lval, instr_tree, il_info, il_info) is det.
-:- mode store(in, out, in, out) is det.
+:- pred store(globals, mlds__lval, instr_tree, il_info, il_info) is det.
+:- mode store(in, in, out, in, out) is det.
-store(field(_MaybeTag, Rval, FieldNum, FieldType, ClassType), Instrs) -->
+store(Globals, field(_MaybeTag, Rval, FieldNum, FieldType, ClassType), Instrs)
+ -->
DataRep =^ il_data_rep,
- { get_fieldref(DataRep, FieldNum, FieldType, ClassType,
- FieldRef, CastClassInstrs) },
- load(Rval, RvalLoadInstrs),
+ { get_fieldref(DataRep, FieldNum, FieldType, ClassType, FieldRef,
+ CastClassInstrs) },
+ load(Globals, Rval, RvalLoadInstrs),
{ Instrs = tree__list([
CastClassInstrs,
RvalLoadInstrs,
instr_node(stfld(FieldRef))]) }.
-store(mem_ref(_Rval, _Type), _Instrs, Info, Info) :-
+store(_Globals, mem_ref(_Rval, _Type), _Instrs, Info, Info) :-
% you always need load the reference first, then
% the value, then stind it. There's no swap
% instruction. Annoying, eh?
unexpected(this_file, "store into mem_ref").
-store(var(Var, VarType), Instrs) -->
+store(_Globals, var(Var, VarType), Instrs) -->
DataRep =^ il_data_rep,
{ mangle_mlds_var(Var, MangledVarStr) },
=(Info),
@@ -2305,9 +2347,9 @@
%
-:- pred unaryop_to_il(mlds__unary_op, mlds__rval, instr_tree, il_info,
+:- pred unaryop_to_il(globals, mlds__unary_op, mlds__rval, instr_tree, il_info,
il_info) is det.
-:- mode unaryop_to_il(in, in, out, in, out) is det.
+:- mode unaryop_to_il(in, in, in, out, in, out) is det.
% Once upon a time the MLDS code generator generated primary tag tests
% (but we don't use primary tags).
@@ -2316,28 +2358,31 @@
% always succeed in the tag test (which is good, with tagbits = 0
% we want to always succeed all primary tag tests).
-unaryop_to_il(std_unop(mktag), _, comment_node("mktag (a no-op)")) --> [].
-unaryop_to_il(std_unop(tag), _, Instrs) -->
- load(const(int_const(0)), Instrs).
-unaryop_to_il(std_unop(unmktag), _, comment_node("unmktag (a no-op)")) --> [].
-unaryop_to_il(std_unop(strip_tag),_,comment_node("strip_tag (a no-op)")) --> [].
-unaryop_to_il(std_unop(mkbody), _, comment_node("mkbody (a no-op)")) --> [].
-unaryop_to_il(std_unop(unmkbody), _, comment_node("unmkbody (a no-op)")) --> [].
-
-unaryop_to_il(std_unop(hash_string), _, node([call(il_mercury_string_hash)]))
+unaryop_to_il(_Globals, std_unop(mktag), _, comment_node("mktag (a no-op)")) --> [].
+unaryop_to_il(Globals, std_unop(tag), _, Instrs) -->
+ load(Globals, const(int_const(0)), Instrs).
+unaryop_to_il(_Globals, std_unop(unmktag), _, comment_node("unmktag (a no-op)")) --> [].
+unaryop_to_il(_Globals, std_unop(strip_tag), _,
+ comment_node("strip_tag (a no-op)")) --> [].
+unaryop_to_il(_Globals, std_unop(mkbody), _, comment_node("mkbody (a no-op)"))
--> [].
-unaryop_to_il(std_unop(bitwise_complement), _, node([not])) --> [].
+unaryop_to_il(_Globals, std_unop(unmkbody), _,
+ comment_node("unmkbody (a no-op)")) --> [].
+
+unaryop_to_il(_Globals, std_unop(hash_string), _,
+ node([call(il_mercury_string_hash)])) --> [].
+unaryop_to_il(_Globals, std_unop(bitwise_complement), _, node([not])) --> [].
% might want to revisit this and define not to be only
% valid on 1 or 0, then we can use ldc.i4.1 and xor,
% which might be more efficient.
-unaryop_to_il(std_unop((not)), _,
+unaryop_to_il(_Globals, std_unop((not)), _,
node([ldc(int32, i(1)), clt(unsigned)])) --> [].
% XXX should detect casts to System.Array from
% array types and ignore them, as they are not
% necessary.
-unaryop_to_il(cast(DestType), SrcRval, Instrs) -->
+unaryop_to_il(_Globals, cast(DestType), SrcRval, Instrs) -->
DataRep =^ il_data_rep,
{ DestILType = mlds_type_to_ilds_type(DataRep, DestType) },
{ rval_to_type(SrcRval, SrcType) },
@@ -2453,7 +2498,7 @@
)
}.
-unaryop_to_il(box(UnboxedType), _, Instrs) -->
+unaryop_to_il(_Globals, box(UnboxedType), _, Instrs) -->
DataRep =^ il_data_rep,
{ UnboxedILType = mlds_type_to_ilds_type(DataRep, UnboxedType) },
{ already_boxed(UnboxedILType) ->
@@ -2464,7 +2509,7 @@
Instrs = convert_to_object(UnboxedILType)
}.
-unaryop_to_il(unbox(UnboxedType), Rval, Instrs) -->
+unaryop_to_il(_Globals, unbox(UnboxedType), Rval, Instrs) -->
DataRep =^ il_data_rep,
{ rval_to_type(Rval, RvalType) },
{ UnboxedILType = mlds_type_to_ilds_type(DataRep, UnboxedType) },
@@ -2632,29 +2677,29 @@
% the peephole optimizer pick this one up. Since it's pretty easy
% to detect I've left it here for now.
-:- pred generate_condition(rval, instr_tree, string,
+:- pred generate_condition(globals, rval, instr_tree, string,
il_info, il_info).
-:- mode generate_condition(in, out, out, in, out) is det.
+:- mode generate_condition(in, in, out, out, in, out) is det.
-generate_condition(Rval, Instrs, ElseLabel) -->
+generate_condition(Globals, Rval, Instrs, ElseLabel) -->
il_info_make_next_label(ElseLabel),
(
{ Rval = binop(eq, Operand1, Operand2) }
->
- load(Operand1, Op1Instr),
- load(Operand2, Op2Instr),
+ load(Globals, Operand1, Op1Instr),
+ load(Globals, Operand2, Op2Instr),
{ OpInstr = instr_node(
bne(unsigned, label_target(ElseLabel))) },
{ Instrs = tree__list([Op1Instr, Op2Instr, OpInstr]) }
;
{ Rval = binop(ne, Operand1, Operand2) }
->
- load(Operand1, Op1Instr),
- load(Operand2, Op2Instr),
+ load(Globals, Operand1, Op1Instr),
+ load(Globals, Operand2, Op2Instr),
{ OpInstr = instr_node(beq(label_target(ElseLabel))) },
{ Instrs = tree__list([Op1Instr, Op2Instr, OpInstr]) }
;
- load(Rval, RvalLoadInstrs),
+ load(Globals, Rval, RvalLoadInstrs),
{ ExtraInstrs = instr_node(brfalse(label_target(ElseLabel))) },
{ Instrs = tree__list([RvalLoadInstrs, ExtraInstrs]) }
).
@@ -3543,7 +3588,7 @@
fieldref, instr_tree).
:- mode get_fieldref(in, in, in, in, out, out) is det.
-get_fieldref(DataRep, FieldNum, FieldType, ClassType0,
+get_fieldref(DataRep, FieldNum, FieldType, ClassType0,
FieldRef, CastClassInstrs) :-
( ClassType0 = mlds__ptr_type(ClassType1) ->
ClassType = ClassType1
@@ -3557,36 +3602,58 @@
;
FieldILType = FieldILType0
),
- (
- FieldNum = offset(OffsetRval),
- ClassName = mlds_type_to_ilds_class_name(DataRep, ClassType),
- ( OffsetRval = const(int_const(Num)) ->
- string__format("f%d", [i(Num)], FieldId)
+ (
+ % XXX Field offsets in bytes have not yet been
+ % implemented in the IL backend. This switch option
+ % is only to ensure predicate is det.
+ FieldNum = byte_offset(OffsetInBytesRval),
+ ClassName = mlds_type_to_ilds_class_name(DataRep,
+ ClassType),
+ ( OffsetInBytesRval = const(int_const(NumBytes)) ->
+ string__format("f%d", [i(NumBytes)], FieldId)
+ ;
+ sorry(this_file,
+ "offsets for non-int_const rvals")
+ ),
+ CastClassInstrs = empty
;
- sorry(this_file,
- "offsets for non-int_const rvals")
- ),
- CastClassInstrs = empty
- ;
- FieldNum = named_field(qual(ModuleName, FieldId), _CtorType),
+ FieldNum = word_offset(OffsetInWordsRval),
+ ClassName = mlds_type_to_ilds_class_name(DataRep,
+ ClassType),
+ ( OffsetInWordsRval = const(int_const(NumWords)) ->
+ string__format("f%d", [i(NumWords)], FieldId)
+ ;
+ sorry(this_file,
+ "offsets for non-int_const rvals")
+ ),
+ CastClassInstrs = empty
+ ;
+ FieldNum = named_field(qual(ModuleName, FieldId),
+ _CtorType),
% The MLDS doesn't record which qualifiers are class qualifiers
% and which are namespace qualifiers... we first generate
% a name for the CtorClass as if it wasn't nested, and then
% we call fixup_class_qualifiers to make it correct.
% XXX This is a bit of a hack. It would be nicer for the
% MLDS to keep the information around.
- CtorClassName = mlds_module_name_to_class_name(ModuleName),
- PtrClassName = mlds_type_to_ilds_class_name(DataRep, ClassType),
- ClassName = fixup_class_qualifiers(CtorClassName, PtrClassName),
- (
- PtrClassName = CtorClassName
- ->
- CastClassInstrs = empty
- ;
- CastClassInstrs = instr_node(
- castclass(ilds__type([], class(ClassName))))
- )
- ),
+ CtorClassName =
+ mlds_module_name_to_class_name(ModuleName),
+ PtrClassName =
+ mlds_type_to_ilds_class_name(DataRep,
+ ClassType),
+ ClassName =
+ fixup_class_qualifiers(CtorClassName,
+ PtrClassName),
+ (
+ PtrClassName = CtorClassName
+ ->
+ CastClassInstrs = empty
+ ;
+ CastClassInstrs =
+ instr_node( castclass(ilds__type([],
+ class(ClassName))))
+ )
+ ),
FieldRef = make_fieldref(FieldILType, ClassName, FieldId).
% The CtorClass will be nested inside the base class.
Index: compiler/mlds_to_java.m
===================================================================
RCS file: /home/mercury1/repository//mercury/compiler/mlds_to_java.m,v
retrieving revision 1.24
diff -u -r1.24 mlds_to_java.m
--- compiler/mlds_to_java.m 22 Feb 2002 01:51:09 -0000 1.24
+++ compiler/mlds_to_java.m 24 Feb 2002 08:54:29 -0000
@@ -2573,7 +2573,11 @@
:- pred output_lval(mlds__lval, io__state, io__state).
:- mode output_lval(in, di, uo) is det.
-output_lval(field(_MaybeTag, Rval, offset(OffsetRval), FieldType,
+
+ % XXX Field offsets in bytes have not yet been implemented in the Java
+ % backend. This byte_offset alternative is only to ensure the
+ % output_lval predicate is det, and is not correct.
+output_lval(field(_MaybeTag, Rval, byte_offset(OffsetInBytesRval), FieldType,
_ClassType)) -->
(
{ FieldType = mlds__generic_type
@@ -2591,9 +2595,29 @@
io__write_string("((java.lang.Object[]) "),
output_rval(Rval),
io__write_string(")["),
- output_rval(OffsetRval),
+ output_rval(OffsetInBytesRval),
io__write_string("]").
+output_lval(field(_MaybeTag, Rval, word_offset(OffsetInWordsRval), FieldType,
+ _ClassType)) -->
+ (
+ { FieldType = mlds__generic_type
+ ; FieldType = mlds__mercury_type(term__variable(_), _, _)
+ }
+ ->
+ []
+ ;
+ % The field type for field(_, _, offset(_), _, _) lvals
+ % must be something that maps to MR_Box.
+ { error("unexpected field type") }
+ ),
+ % XXX We shouldn't need this cast here, but there are cases where
+ % it is needed and the MLDS doesn't seem to generate it.
+ io__write_string("((java.lang.Object[]) "),
+ output_rval(Rval),
+ io__write_string(")["),
+ output_rval(OffsetInWordsRval),
+ io__write_string("]").
output_lval(field(_MaybeTag, PtrRval, named_field(FieldName, CtorType),
_FieldType, _PtrType)) -->
Index: compiler/mlds_to_mcpp.m
===================================================================
RCS file: /home/mercury1/repository//mercury/compiler/mlds_to_mcpp.m,v
retrieving revision 1.25
diff -u -r1.25 mlds_to_mcpp.m
--- compiler/mlds_to_mcpp.m 21 Jan 2002 04:39:20 -0000 1.25
+++ compiler/mlds_to_mcpp.m 24 Feb 2002 08:56:59 -0000
@@ -488,12 +488,23 @@
{ FieldId = qual(_, FieldName) },
io__write_string(FieldName).
-write_managed_cpp_lval(field(_, Rval, offset(OffSet), _, _)) -->
+ % XXX Field offsets have not yet been implemented in the managed C++
+ % backend. This byte_offset alternative is only to ensure the predicate
+ % is det.
+write_managed_cpp_lval(field(_, Rval, byte_offset(OffSetInBytes), _, _)) -->
io__write_string("("),
write_managed_cpp_rval(Rval),
io__write_string(")"),
io__write_string("["),
- write_managed_cpp_rval(OffSet),
+ write_managed_cpp_rval(OffSetInBytes),
+ io__write_string("]").
+
+write_managed_cpp_lval(field(_, Rval, word_offset(OffSetInWords), _, _)) -->
+ io__write_string("("),
+ write_managed_cpp_rval(Rval),
+ io__write_string(")"),
+ io__write_string("["),
+ write_managed_cpp_rval(OffSetInWords),
io__write_string("]").
write_managed_cpp_lval(mem_ref(Rval, _)) -->
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository//mercury/compiler/options.m,v
retrieving revision 1.358
diff -u -r1.358 options.m
--- compiler/options.m 2 Mar 2002 12:43:17 -0000 1.358
+++ compiler/options.m 3 Mar 2002 08:14:45 -0000
@@ -200,7 +200,10 @@
; num_tag_bits
; num_reserved_addresses
; num_reserved_objects
+ ; bits_per_byte
+ ; bits_per_char
; bits_per_word
+ ; bits_per_float
; bytes_per_word
% The undocumented conf_low_tag_bits option
% is used by the `mmc' script to pass the
@@ -216,6 +219,7 @@
; unboxed_float
; unboxed_enums
; unboxed_no_tag_types
+ ; unboxed_object_fields
; sync_term_size % in words
% LLDS back-end compilation model options
@@ -706,7 +710,10 @@
% instead
num_reserved_addresses - int(0),
num_reserved_objects - int(0),
+ bits_per_byte - int(8),
+ bits_per_char - int(8),
bits_per_word - int(32),
+ bits_per_float - int(64),
% A good default for the current
% generation of architectures.
bytes_per_word - int(4),
@@ -723,6 +730,7 @@
unboxed_float - bool(no),
unboxed_enums - bool(yes),
unboxed_no_tag_types - bool(yes),
+ unboxed_object_fields - bool(no),
% LLDS back-end compilation model options
gcc_non_local_gotos - bool(yes),
@@ -1201,12 +1209,16 @@
long_option("num-tag-bits", num_tag_bits).
long_option("num-reserved-addresses", num_reserved_addresses).
long_option("num-reserved-objects", num_reserved_objects).
+long_option("bits-per-byte", bits_per_byte).
+long_option("bits-per-char", bits_per_char).
long_option("bits-per-word", bits_per_word).
+long_option("bits-per-float", bits_per_float).
long_option("bytes-per-word", bytes_per_word).
long_option("conf-low-tag-bits", conf_low_tag_bits).
long_option("unboxed-float", unboxed_float).
long_option("unboxed-enums", unboxed_enums).
long_option("unboxed-no-tag-types", unboxed_no_tag_types).
+long_option("unboxed-object-fields", unboxed_object_fields).
long_option("highlevel-data", highlevel_data).
long_option("high-level-data", highlevel_data).
% LLDS back-end compilation model options
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing deep
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing detail
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/exceptions
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lazy_evaluation/examples
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/opium_m
cvs diff: Diffing extras/opium_m/non-regression-tests
cvs diff: Diffing extras/opium_m/scripts
cvs diff: Diffing extras/opium_m/source
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing java
cvs diff: Diffing library
cvs diff: Diffing lp_solve
cvs diff: Diffing lp_solve/lp_examples
cvs diff: Diffing profiler
cvs diff: Diffing quickcheck
cvs diff: Diffing quickcheck/tutes
cvs diff: Diffing readline
cvs diff: Diffing readline/doc
cvs diff: Diffing readline/examples
cvs diff: Diffing readline/shlib
cvs diff: Diffing readline/support
cvs diff: Diffing robdd
cvs diff: Diffing runtime
Index: runtime/mercury_tags.h
===================================================================
RCS file: /home/mercury1/repository//mercury/runtime/mercury_tags.h,v
retrieving revision 1.16
diff -u -r1.16 mercury_tags.h
--- runtime/mercury_tags.h 18 Feb 2002 07:01:21 -0000 1.16
+++ runtime/mercury_tags.h 23 Feb 2002 05:51:14 -0000
@@ -79,11 +79,13 @@
** The hl_ variants are the same, except their return type is MR_Box
** rather than MR_Word. These are used by the MLDS->C back-end.
*/
-#define MR_hl_field(t, p, i) ((MR_Box *) MR_body((p), (t)))[i]
-#define MR_hl_const_field(t, p, i) ((const MR_Box *) MR_body((p), (t)))[i]
+#define MR_hl_field(t, p, i) ((MR_Box *) MR_body((p), (t)))[i]
+#define MR_hl_const_field(t, p, i) ((const MR_Box *) MR_body((p), (t)))[i]
+#define MR_hl_byte_field(t, p, i, c) (*((c *) (((MR_Byte *) MR_body((p), (t)))[i])))
-#define MR_hl_mask_field(p, i) ((MR_Box *) MR_strip_tag(p))[i]
+#define MR_hl_mask_field(p, i) ((MR_Box *) MR_strip_tag(p))[i]
#define MR_hl_const_mask_field(p, i) ((const MR_Box *) MR_strip_tag(p))[i]
+#define MR_hl_mask_byte_field(p, i, c) (*((c *) ((MR_Byte *) MR_strip_tag(p))[i]))
/*
** the following macros are used by handwritten C code that needs to access
Index: runtime/mercury_types.h
===================================================================
RCS file: /home/mercury1/repository//mercury/runtime/mercury_types.h,v
retrieving revision 1.28
diff -u -r1.28 mercury_types.h
--- runtime/mercury_types.h 20 Feb 2002 05:26:50 -0000 1.28
+++ runtime/mercury_types.h 20 Feb 2002 23:57:19 -0000
@@ -54,6 +54,7 @@
** sizeof(MR_Word) == sizeof(MR_Integer) == sizeof(MR_Code*).
*/
+typedef unsigned char MR_Byte;
typedef MR_uintptr_t MR_Word;
typedef MR_intptr_t MR_Integer;
typedef MR_uintptr_t MR_Unsigned;
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing trax
cvs diff: Diffing trial
cvs diff: Diffing util
More information about the reviews
mailing list