mercury/compiler/llds.m

%-----------------------------------------------------------------------------%
% Copyright (C) 1993-1999 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%

% LLDS - The Low-Level Data Structure.

% This module defines the LLDS data structure itself.

% Main authors: conway, fjh.

%-----------------------------------------------------------------------------%

:- module llds.

:- interface.

:- import_module hlds_pred, hlds_data, tree, prog_data, (inst).
:- import_module builtin_ops.

:- import_module bool, assoc_list, list, map, set, std_util.

%-----------------------------------------------------------------------------%

:- type code_model
	--->	model_det		% functional & total
	;	model_semi		% just functional
	;	model_non.		% not functional

%-----------------------------------------------------------------------------%

% c_interface_info holds information used when generating
% code that uses the C interface.
:- type c_interface_info
	---> c_interface_info(
		module_name,
		% info about stuff imported from C:
		c_header_info,
		c_body_info,
		% info about stuff exported to C:
		c_export_decls,
		c_export_defns
	).

:- type c_header_info 	==	list(c_header_code).	% in reverse order
:- type c_body_info 	==	list(c_body_code).	% in reverse order

:- type c_header_code	==	pair(string, prog_context).
:- type c_body_code	==	pair(string, prog_context).

:- type c_export_defns == list(c_export).
:- type c_export_decls == list(c_export_decl).

:- type c_export_decl
	---> c_export_decl(
		string,		% return type
		string,		% function name
		string		% argument declarations
	).

	% the code for `pragma export' is generated directly as strings
	% by export.m.
:- type c_export	==	string.

%-----------------------------------------------------------------------------%

:- import_module continuation_info.

:- type global_data.

:- pred global_data_init(global_data::out) is det.

:- pred global_data_add_new_proc_var(global_data::in,
	pred_proc_id::in, comp_gen_c_var::in, global_data::out) is det.

:- pred global_data_add_new_proc_layout(global_data::in,
	pred_proc_id::in, proc_layout_info::in, global_data::out) is det.

:- pred global_data_update_proc_layout(global_data::in,
	pred_proc_id::in, proc_layout_info::in, global_data::out) is det.

:- pred global_data_add_new_non_common_static_datas(global_data::in,
	list(comp_gen_c_data)::in, global_data::out) is det.

:- pred global_data_maybe_get_proc_layout(global_data::in, pred_proc_id::in,
	proc_layout_info::out) is semidet.

:- pred global_data_get_proc_layout(global_data::in, pred_proc_id::in,
	proc_layout_info::out) is det.

:- pred global_data_get_all_proc_vars(global_data::in,
	list(comp_gen_c_var)::out) is det.

:- pred global_data_get_all_proc_layouts(global_data::in,
	list(proc_layout_info)::out) is det.

:- pred global_data_get_all_non_common_static_data(global_data::in,
	list(comp_gen_c_data)::out) is det.

%-----------------------------------------------------------------------------%

%
% The type `c_file' is the actual LLDS.
%
:- type c_file	
	--->	c_file(
			module_name,
			c_header_info,
			list(user_c_code),
			list(c_export),
			list(comp_gen_c_var),
			list(comp_gen_c_data),
			list(comp_gen_c_module)
		).

	% Some C code from a `pragma c_code' declaration that is not
	% associated with a given procedure.
:- type user_c_code
	--->	user_c_code(
			string,			% C code
			term__context		% source code location
		).

	% Global variables generated by the compiler.
:- type comp_gen_c_var
	--->	tabling_pointer_var(
			module_name,		% The basename of this C file.
			proc_label		% The id of the procedure
						% whose table this variable
						% represents.
		).

	% Global data generated by the compiler. Usually readonly,
	% with one exception: data containing code addresses must
	% be initialized.
:- type comp_gen_c_data
	--->	comp_gen_c_data(
			module_name,		% The basename of this C file.
			data_name,		% A representation of the name
						% of the variable; it will be
						% qualified with the basename.
			bool,			% Should this item be exported
						% from this Mercury module?
						% XXX Actually this field is
						% redundant; see linkage/2
						% in llds_out.m.
			list(maybe(rval)),	% The arguments of the create.
			create_arg_types,	% May specify the types of the
						% arguments of the create.
			list(pred_proc_id)	% The procedures referenced.
						% Used by dead_proc_elim.
		)
	;	trace_call_info(
			% This structure contains all the information
			% we pass to a particular call to MR_trace_struct.

			label,			% The label corresponding
						% to this point in the code,
						% whose layout structure
						% describes the current
						% contents of registers and
						% stack slots.
			string,			% A representation of the
						% goal_path of the current
						% position in the procedure.
			int,			% The number of the highest
						% numbered r register that is
						% in use at the time of the
						% call.
			trace_port		% The type of port we are
						% tracing.
		).

:- type comp_gen_c_module
	--->	comp_gen_c_module(
			string,			% the name of this C module
			list(c_procedure) 	% code
		).

:- type c_procedure
	--->	c_procedure(
			string,			% predicate name
			int,			% arity
			pred_proc_id,		% the pred_proc_id this code
			list(instruction)	% the code for this procedure
		).

:- type llds_proc_id	==	int.

	% we build up instructions as trees and then flatten
	% the tree to get a list.
:- type code_tree	==	tree(list(instruction)).

:- type instruction	==	pair(instr, string).
			%	instruction, comment

:- type call_model
	--->	det
	;	semidet
	;	nondet(bool).

	% `instr' defines the various LLDS virtual machine instructions.
	% Each instruction gets compiled to a simple piece of C code
	% or a macro invocation.
:- type instr
	--->	comment(string)
			% Insert a comment into the output code.

	;	livevals(set(lval))
			% A list of which registers and stack locations
			% are currently live.

	;	block(int, int, list(instruction))
			% block(NumIntTemps, NumFloatTemps, Instrs):
			% A list of instructions that make use of
			% some local temporary variables.

	;	assign(lval, rval)
			% assign(Location, Value):
			% Assign the value specified by rval to the location
			% specified by lval.

	;	call(code_addr, code_addr, list(liveinfo), call_model)
			% call(Target, Continuation, _, _) is the same as
			% succip = Continuation; goto(Target).
			% The third argument is the live value info for the
			% values live on return. The last gives the model
			% of the called procedure, and if it is nondet,
			% says whether tail recursion elimination is
			% potentially applicable to the call.

	;	mkframe(nondet_frame_info, code_addr)
			% mkframe(NondetFrameInfo, CodeAddr) creates a nondet
			% stack frame. NondetFrameInfo says whether the frame
			% is an ordinary frame, containing the variables of a
			% model_non procedure, or a temp frame used only for
			% its redoip/redofr slots. If the former, it also
			% gives the details of the size of the variable parts
			% of the frame (temp frames have no variable sized
			% parts). CodeAddr is the code address to branch to
			% when trying to generate the next solution from this
			% choice point.

	;	label(label)
			% Defines a label that can be used as the
			% target of calls, gotos, etc.

	;	goto(code_addr)
			% goto(Target)
			% Branch to the specified address.
			% Note that jumps to do_fail, do_redo, etc., can get
			% optimized into the invocations of macros
			% fail(), redo(), etc..

	;	computed_goto(rval, list(label))
			% Evaluate rval, which should be an integer,
			% and jump to the (rval+1)th label in the list.
			% e.g. computed_goto(2, [A, B, C, D])
			% will branch to label C.

	;	c_code(string)
			% Do whatever is specified by the string,
			% which can be any piece of C code that
			% does not have any non-local flow of control.

	;	if_val(rval, code_addr)
			% If rval is true, then goto code_addr.

	;	incr_hp(lval, maybe(tag), rval, string)
			% Get a memory block of a size given by an rval
			% and put its address in the given lval,
			% possibly after tagging it with a given tag.
			% The string gives the name of the type constructor
			% of the memory cell for use in memory profiling.

	;	mark_hp(lval)
			% Tell the heap sub-system to store a marker
			% (for later use in restore_hp/1 instructions)
			% in the specified lval

	;	restore_hp(rval)
			% The rval must be a marker as returned by mark_hp/1.
			% The effect is to deallocate all the memory which
			% was allocated since that call to mark_hp.

	;	store_ticket(lval)
			% Allocate a new "ticket" and store it in the lval.

	;	reset_ticket(rval, reset_trail_reason)
			% The rval must specify a ticket allocated with
			% `store_ticket' and not yet invalidated or
			% deallocated.
			% If undo_reason is `undo' or `exception', restore
			% any mutable global state to the state it was in when
			% the ticket was obtained with store_ticket();
			% invalidates any tickets allocated after this one.
			% If undo_reason is `commit' or `solve', leave the state
			% unchanged, just check that it is safe to commit
			% to this solution (i.e. that there are no outstanding
			% delayed goals -- this is the "floundering" check).
			% Note that we do not discard trail entries after
			% commits, because that would in general be unsafe.
			%
			% Any invalidated ticket is useless and should
			% be deallocated with either `discard_ticket'
			% or `discard_tickets_to'.

	;	discard_ticket
			% Deallocates the most-recently allocated ticket.

	;	mark_ticket_stack(lval)
			% Tell the trail sub-system to store a ticket counter
			% (for later use in discard_tickets_upto)
			% in the specified lval.

	;	discard_tickets_to(rval)
			% The rval must be a ticket counter obtained via
			% `mark_ticket_stack' and not yet invalidated.
			% Deallocates any trail tickets allocated after
			% the corresponding call to mark_ticket_stack.
			% Invalidates any later ticket counters.

	;	incr_sp(int, string)
			% Increment the det stack pointer. The string is
			% the name of the procedure, for use in stack dumps.
			% It is used only in grades in which stack dumps are
			% enabled (i.e. not in grades where SPEED is defined).

	;	decr_sp(int)
			% Decrement the det stack pointer.

	;	pragma_c(list(pragma_c_decl), list(pragma_c_component),
				may_call_mercury, maybe(label), bool)
			% The first argument says what local variable
			% declarations are required for the following
			% components, which in turn can specify how
			% the inputs should be placed in their variables,
			% how the outputs should be picked up from their
			% variables, and C code both from the program
			% and the compiler. These components can be
			% sequenced in various ways. This flexibility
			% is needed for nondet pragma C codes, which
			% need different copies of several components
			% for different paths tthrough the code.
			%
			% The third argument says whether the user C code
			% components may call Mercury; certain optimizations
			% can be performed across pragma_c instructions that
			% cannot call Mercury.
			%
			% Some components in some pragma_c instructions
			% refer to a Mercury label. If they do, we must
			% prevent the label from being optimized away.
			% To make it known to labelopt, we mention it in
			% the fourth arg.
			%
			% The fifth argument says whether the contents
			% of the pragma C code can refer to stack slots.
			% User-written shouldn't refer to stack slots,
			% the question is whether the compiler-generated
			% C code does.

	;	init_sync_term(lval, int)
			% Initialize a synchronization term.
			% the first arguement contains the lvalue into
			% which we will store the synchronization term,
			% and the second argument indicates how many
			% branches we expect to join at the end of the
			% parallel conjunction.
			% (See the documentation in par_conj_gen.m and
			% runtime/context.{c,h} for further information about
			% synchronisation terms.)

	;	fork(label, label, int)
			% Create a new context.
			% fork(Child, Parent, NumSlots) creates a new thread
			% which will start executing at Child. After spawning
			% execution in the child, control branches to Parent.
			% NumSlots is the number of stack slots that need to
			% be copied to the child's stack (see comments in
			% runtime/context.{h,c}).

	;	join_and_terminate(lval)
			% Signal that this thread of execution has finished in
			% the current parallel conjunction, then terminate it.
			% The synchronisation term is specified by the
			% given lval. (See the documentation in par_conj_gen.m
			% and runtime/context.{c,h} for further information
			% about synchronisation terms.)

	;	join_and_continue(lval, label)
			% Signal that this thread of execution has finished
			% in the current parallel conjunction, then branch to
			% the given label. The synchronisation
			% term is specified by the given lval.
	.

:- type nondet_frame_info
	--->	temp_frame(
			temp_frame_type
		)
	;	ordinary_frame(
			string, 		% Name of the predicate.
			int,			% Number of framevar slots.
			maybe(pragma_c_struct)	% If yes, the frame should
						% also contain this struct
						% (for use by a model_non
						% pragma C code).
		).

	% Temporary frames on the nondet stack exist only to provide a failure
	% environment, i.e. a place to store a redoip and a redofr. Accurate
	% garbage collection and execution tracing need to know how to
	% interpret the layout information associated with the label whose
	% address is in the redoip slot. If the label is in a procedure that
	% stores its variables on the nondet stack, the redofr slot will give
	% the address of the relevant stack frame. If the label is in a
	% procedure that stores its variables on the det stack, the temporary
	% frame will contain an extra slot containing the address of the
	% relevant frame on the det stack.
:- type temp_frame_type
	--->	det_stack_proc
	;	nondet_stack_proc.

	% Procedures defined by nondet pragma C codes must have some way of
	% preserving information after a success, so that when control
	% backtracks to the procedure, the C code knows what to do.
	% Our implementation saves this information in a C struct.
	% Programmers must include the declaration of the fields of this
	% C struct in the `pragma c_code' declaration itself.
	% A pragma_c_struct holds information about this C struct.
:- type pragma_c_struct
	--->	pragma_c_struct(
			string,		% The name of the struct tag.
			string,		% The field declarations, supplied
					% by the user in the `pragma c_code'
					% declaration.
			maybe(prog_context)
					% Where the field declarations
					% originally appeared.
		).

	% A pragma_c_decl holds the information needed for the declaration
	% of a local variable in a block of C code emitted for a pragma_c
	% instruction.
:- type pragma_c_decl
	--->	pragma_c_arg_decl(
			% This local variable corresponds to a procedure arg.
			type,	% The Mercury type of the argument.
			string	% The name of the local variable that
				% will hold the value of that argument
				% inside the C block.
		)
	;	pragma_c_struct_ptr_decl(
			% This local variable holds the address of the
			% save struct.
			string,	% The name of the C struct tag of the save
				% struct; the type of the local variable
				% will be a pointer to a struct with this tag.
			string	% The name of the local variable.
		).

	% A pragma_c_component holds one component of a pragma_c instruction.
:- type pragma_c_component
	--->	pragma_c_inputs(list(pragma_c_input))
	;	pragma_c_outputs(list(pragma_c_output))
	;	pragma_c_user_code(maybe(prog_context), string)
	;	pragma_c_raw_code(string).

	% A pragma_c_input represents the code that initializes one
	% of the input variables for a pragma_c instruction.
:- type pragma_c_input
	--->	pragma_c_input(string, type, rval).
				% variable name, type, variable value.

	% A pragma_c_output represents the code that stores one of
	% of the outputs for a pragma_c instruction.
:- type pragma_c_output  
	--->	pragma_c_output(lval, type, string).
				% where to put the output val, type and name
				% of variable containing the output val

	% see runtime/mercury_trail.h
:- type reset_trail_reason
	--->	undo
	;	commit
	;	solve
	;	exception
	;	gc
	.

	% The kinds of ports for which the code we generate will
	% call MR_trace. The redo port is not on this list, because for that
	% port the code that calls MR_trace is not in compiler-generated code,
	% but in the runtime system.  Likewise for the exception port.
	% (The same comment applies to the type `external_trace_port'
	% in trace.m.)
:- type trace_port
	--->	call
	;	exit
	;	fail
	;	ite_then
	;	ite_else
	;	switch
	;	disj
	;	nondet_pragma_first
	;	nondet_pragma_later.

	% Each call instruction has a list of liveinfo, which stores
	% information about which variables are live after the call
	% (that is, on return).  The information is intended for use by
	% the non-conservative garbage collector.
:- type liveinfo
	--->	live_lvalue(
			layout_locn,
				% What location does this lifeinfo structure
				% refer to?
			live_value_type,
				% What is the type of this live value?
			map(tvar, set(layout_locn))
				% For each tvar that is a parameter of the
				% type of this value, give the set of
				% locations where the type_info variable
				% describing the actual type bound to the
				% type parameter may be found.
				%
				% We record all the locations of the typeinfo,
				% in case different paths of arriving a this
				% program point leave the typeinfo in different
				% sets of locations. However, there must be at
				% least type_info location that is valid
				% along all paths leading to this point.
		).

	% For an explanation of this type, see the comment on
	% stack_layout__represent_locn.
:- type layout_locn
	--->	direct(lval)
	;	indirect(lval, int).

	% live_value_type describes the different sorts of data that
	% can be considered live.
:- type live_value_type 
	--->	succip				% A stored succip.
	;	curfr				% A stored curfr.
	;	maxfr				% A stored maxfr.
	;	redoip				% A stored redoip.
	;	redofr				% A stored redofr.
	;	hp				% A stored heap pointer.
	;	var(prog_var, string, type, inst)
						% A variable (the var number
						% and name are for execution
						% tracing; we have to store
						% the name here because when
						% we want to use the
						% live_value_type, we won't
						% have access to the varset).
	;	unwanted.			% Something we don't need,
						% or at least don't need
						% information about.

	% An lval represents a data location or register that can be used
	% as the target of an assignment.
:- type lval --->

	/* virtual machine registers */

		reg(reg_type, int)
				% One of the general-purpose virtual machine
				% registers (either an int or float reg).

	;	succip		% Virtual machine register holding the
				% return address for det/semidet code.

	;	maxfr		% Virtual machine register holding a pointer
				% to the top of nondet stack.

	;	curfr		% Virtual machine register holding a pointer
				% to the current nondet stack frame.

	;	hp		% Virtual machine register holding the heap
				% pointer.

	;	sp		% Virtual machine register point to the
				% top of det stack.

	;	temp(reg_type, int)
				% A local temporary register.
				% These temporary registers are actually
				% local variables declared in `block'
				% instructions.  They may only be
				% used inside blocks.  The code generator
				% doesn't generate these; they are introduced
				% by value numbering.  The basic idea is
				% to improve efficiency by using local
				% variables that the C compiler may be
				% able to allocate in a register rather than
				% using stack slots.

	/* values on the stack */

	;	stackvar(int)	% A det stack slot. The number is the offset
				% relative to the current value of `sp'.
				% These are used in both det and semidet code.
				% Stackvar slot numbers start at 1.

	;	framevar(int)	% A nondet stack slot. The reference is
				% relative to the current value of `curfr'.
				% These are used in nondet code.
				% Framevar slot numbers start at 0.

	;	succip(rval)	% The succip slot of the specified
				% nondet stack frame; holds the code address
				% to jump to on successful exit from this
				% nondet procedure.

	;	redoip(rval)	% The redoip slot of the specified
				% nondet stack frame; holds the code address
				% to jump to on failure.

	;	redofr(rval)	% the redofr slot of the specified
				% nondet stack frame; holds the address of
				% the frame that the curfr register should be
				% set to when backtracking through the redoip
				% slot.

	;	succfr(rval)	% The succfr slot of the specified
				% nondet stack frame; holds the address of
				% caller's nondet stack frame.  On successful
				% exit from this nondet procedure, we will
				% set curfr to this value.

	;	prevfr(rval)	% The prevfr slot of the specified
				% nondet stack frame; holds the address of
				% the previous frame on the nondet stack.

	/* values on the heap */

	;	field(maybe(tag), rval, rval)
				% field(Tag, Address, FieldNum)
				% selects a field of a compound term.
				% Address is a tagged pointer to a cell
				% on the heap; the offset into the cell
				% is FieldNum words. If Tag is yes, the
				% arg gives the value of the tag; if it is
				% no, the tag bits will have to be masked off.
				% The value of the tag should be given if
				% it is known, since this will lead to
				% faster code.

	/* values somewhere in memory */

	;	mem_ref(rval)	% A word in the heap, in the det stack or
				% in the nondet stack. The rval should have
				% originally come from a mem_addr rval.

	/* pseudo-values */

	;	lvar(prog_var).	% The location of the specified variable.
				% `var' lvals are used during code generation,
				% but should not be present in the LLDS at any
				% stage after code generation.

	% An rval is an expression that represents a value.
:- type rval	
	--->	lval(lval)
		% The value of an `lval' rval is just the value stored in
		% the specified lval.

	;	var(prog_var)
		% The value of a `var' rval is just the value of the
		% specified variable.
		% `var' rvals are used during code generation,
		% but should not be present in the LLDS at any
		% stage after code generation.

	;	create(tag, list(maybe(rval)), create_arg_types,
			static_or_dynamic, int, string)
		% create(Tag, Arguments, MaybeArgTypes, StaticOrDynamic,
		%	LabelNumber, CellKind):
		% A `create' instruction is used during code generation
		% for creating a term, either on the heap or
		% (if the term is constant) as a static constant.
		% After code generation, only constant term create() rvals
		% should be present in the LLDS, others will get transformed
		% to incr_hp(..., Tag, Size) plus assignments to the fields.
		%
		% MaybeArgTypes may explicitly give the C level types of
		% the arguments, although usually these types will be implicit.
		%
		% StaticOrDynamic may say that the cell must be allocated
		% dynamically on the heap, because the resulting data structure
		% must be unique (e.g. if we're doing to do destructive update
		% on it). It may say that the cell must be allocated
		% statically, e.g. because the MaybeArgTypes includes
		% explicitly specified types that differ in size from Word
		% (the code generator cannot fill in such cells).
		% Or it may say that this cell can be allocated either way,
		% subject to other constraints (e.g. a cell cannot be allocated
		% statically unless all of its components are statically
		% allocated as well).
		%
		% The label number is needed for the case when
		% we can construct the term at compile-time
		% and just reference the label.
		%
		% The last argument gives the name of the type constructor
		% of the function symbol of which this is a cell, for use
		% in memory profiling.
		%
		% For the time being, you must leave the argument types
		% implicit if the cell is to be unique. This is because
		% (a) the code generator assumes that each argument of a cell
		% it creates on the heap is the same size as a Word; (b)
		% this assumption may be incorrect with explicitly defined
		% argument types.

	;	mkword(tag, rval)
		% Given a pointer and a tag, mkword returns a tagged pointer.

	;	const(rval_const)

	;	unop(unary_op, rval)

	;	binop(binary_op, rval, rval)

	;	mem_addr(mem_ref).
		% The address of a word in the heap, the det stack or
		% the nondet stack.

:- type static_or_dynamic
	--->	must_be_static
	;	can_be_either
	;	must_be_dynamic.

	% Values of this type specify the C types and therefore the sizes
	% of the arguments of a create rval.
	%
	% If the type is given as yes(LldsType), then the type is the C type
	% corresponding to LldsType. If the type is given as no, then the
	% type is implicit; it is what llds_out__rval_type_as_arg says
	% when given the actual argument.
:- type create_arg_types
	--->	uniform(maybe(llds_type))	% All the arguments have
						% the given C type.
	;	initial(initial_arg_types, create_arg_types)
						% Each element of the assoc
						% list N - T specifies that
						% the next N arguments have
						% type T. The types of the
						% remainder of the arguments
						% are given by the recursive
						% create_arg_types.
	;	none.				% There ought to be no more
						% arguments.

:- type initial_arg_types == assoc_list(int, maybe(llds_type)).

:- type mem_ref
	--->	stackvar_ref(int)		% stack slot number
	;	framevar_ref(int)		% stack slot number
	;	heap_ref(rval, int, int).	% the cell pointer,
						% the tag to subtract,
						% and the field number

:- type rval_const
	--->	true
	;	false
	;	int_const(int)
	;	float_const(float)
	;	string_const(string)
	;	multi_string_const(int, string)
			% a string containing embedded NULLs,
			% whose real length is given by the integer,
			% and not the location of the first NULL
	;	code_addr_const(code_addr)
	;	data_addr_const(data_addr)
	;	label_entry(label).
			% the address of the label (uses ENTRY macro).

:- type data_addr
	--->	data_addr(module_name, data_name).
			% module name; which var

:- type data_name
	--->	common(int)
	;	type_ctor(base_data, string, arity)
			% base_data, type name, type arity
	;	base_typeclass_info(class_id, string)
			% class name & class arity, names and arities of the
			% types
	;	module_layout
			% Layout information for the current module.
	;	proc_layout(label)
			% Layout structure for the procedure with the given
			% entry label.
	;	internal_layout(label)
			% Layout structure for the given internal label.
	;	tabling_pointer(proc_label).
			% A variable that contains a pointer that points to
			% the table used to implement memoization, loopcheck
			% or minimal model semantics for the given procedure.

:- type base_data
	--->	info
			% basic information, including special preds
	;	layout
			% layout information
	;	functors.
			% information on functors

:- type reg_type	
	--->	r		% general-purpose (integer) regs
	;	f.		% floating point regs

:- type label
	--->	local(proc_label, int)	% not proc entry; internal to a
					% procedure
	;	c_local(proc_label)	% proc entry; internal to a C module
	;	local(proc_label)	% proc entry; internal to a Mercury
					% module
	;	exported(proc_label).	% proc entry; exported from a Mercury
					% module

:- type code_addr
	--->	label(label)		% A label defined in this Mercury
					% module.
	;	imported(proc_label)	% A label from another Mercury module.
	;	succip			% The address in the `succip'
					% register.
	;	do_succeed(bool)	% The bool is `yes' if there are any
					% alternatives left.  If the bool is
					% `no', we do a succeed_discard()
					% rather than a succeed().
	;	do_redo
	;	do_fail
	;	do_trace_redo_fail
					% A label in the runtime, the code
					% at which calls MR_trace with a
					% REDO event and then fails.
	;	do_call_closure
	;	do_call_class_method
	;	do_det_aditi_call
	;	do_semidet_aditi_call
	;	do_nondet_aditi_call
	;	do_aditi_insert
	;	do_aditi_delete
	;	do_aditi_bulk_insert
	;	do_aditi_bulk_delete
	;	do_aditi_modify
	;	do_not_reached.		% We should never jump to this address.

	% A proc_label is a label used for the entry point to a procedure.
	% The defining module is the module that provides the code for the
	% predicate, the declaring module contains the `:- pred' declaration.
	% When these are different, as for specialised versions of predicates
	% from `.opt' files, the defining module's name is added as a
	% qualifier to the label.
:- type proc_label
	--->	proc(module_name, pred_or_func, module_name, string,
								int, proc_id)
			% defining module, predicate/function,
			% declaring module, name, arity, mode #
	;	special_proc(module_name, string, module_name, string, int,
								proc_id).
			% defining module, pred name, type module,
			% type name, type arity, mode #

	% A tag (used in mkword, create and field expressions
	% and in incr_hp instructions) is a small integer.
:- type tag	==	int.

	% We categorize the data types used in the LLDS into
	% a small number of categories, for purposes such as
	% choosing the right sort of register for a given value
	% to avoid unnecessary boxing/unboxing of floats.
:- type llds_type
	--->	bool		% A boolean value
				% represented using the C type `Integer'.
	;	int_least8	% A signed value that fits that contains
				% at least eight bits, represented using the
				% C type int_least8_t. Intended for use in
				% static data declarations, not for data
				% that gets stored in registers, stack slots
				% etc.
	;	uint_least8	% An unsigned version of int_least8,
				% represented using the C type uint_least8_t.
	;	int_least16	% A signed value that fits that contains
				% at least sixteen bits, represented using the
				% C type int_least16_t. Intended for use in
				% static data declarations, not for data
				% that gets stored in registers, stack slots
				% etc.
	;	uint_least16	% An unsigned version of int_least16,
				% represented using the C type uint_least16_t.
	;	int_least32	% A signed value that fits that contains
				% at least 32 bits, represented using the
				% C type int_least32_t. Intended for use in
				% static data declarations, not for data
				% that gets stored in registers, stack slots
				% etc.
	;	uint_least32	% An unsigned version of intleast_32,
				% represented using the C type uint_least32_t.
	;	integer		% A Mercury `int', represented in C as a
				% value of type `Integer' (which is
				% a signed integral type of the same
				% size as a pointer).
	;	unsigned	% Something whose C type is `Unsigned'
				% (the unsigned equivalent of `Integer').
	;	float		% A Mercury `float', represented in C as a
				% value of type `Float' (which may be either
				% `float' or `double', but is usually
				% `double').
	;	string		% A Mercury string; represented in C as a
				% value of type `String'.
	;	data_ptr	% A pointer to data; represented in C
				% as a value of C type `Word *'.
	;	code_ptr	% A pointer to code; represented in C
				% as a value of C type `Code *'.
	;	word.		% Something that can be assigned to a value
				% of C type `Word', i.e., something whose
				% size is a word but which may be either
				% signed or unsigned
				% (used for registers, stack slots, etc).

	% given a non-var rval, figure out its type
:- pred llds__rval_type(rval::in, llds_type::out) is det.

	% given a non-var lval, figure out its type
:- pred llds__lval_type(lval::in, llds_type::out) is det.

	% given a constant, figure out its type
:- pred llds__const_type(rval_const::in, llds_type::out) is det.

	% given a unary operator, figure out its return type
:- pred llds__unop_return_type(unary_op::in, llds_type::out) is det.

	% given a unary operator, figure out the type of its argument
:- pred llds__unop_arg_type(unary_op::in, llds_type::out) is det.

	% given a binary operator, figure out its return type
:- pred llds__binop_return_type(binary_op::in, llds_type::out) is det.

	% given a register, figure out its type
:- pred llds__register_type(reg_type::in, llds_type::out) is det.

	% check whether the types of all argument are the same size as word
:- pred llds__all_args_are_word_size(create_arg_types::in, bool::out) is det.

	% check whether an arg of the given type is the same size as word
	% (floats may be bigger than a word, but if so, they are boxed)
:- pred llds__type_is_word_size_as_arg(llds_type::in, bool::out) is det.

:- implementation.
:- import_module require.

llds__lval_type(reg(RegType, _), Type) :-
	llds__register_type(RegType, Type).
llds__lval_type(succip, code_ptr).
llds__lval_type(maxfr, data_ptr).
llds__lval_type(curfr, data_ptr).
llds__lval_type(hp, data_ptr).
llds__lval_type(sp, data_ptr).
llds__lval_type(temp(RegType, _), Type) :-
	llds__register_type(RegType, Type).
llds__lval_type(stackvar(_), word).
llds__lval_type(framevar(_), word).
llds__lval_type(succip(_), code_ptr).
llds__lval_type(redoip(_), code_ptr).
llds__lval_type(redofr(_), data_ptr).
llds__lval_type(succfr(_), data_ptr).
llds__lval_type(prevfr(_), data_ptr).
llds__lval_type(field(_, _, _), word).
llds__lval_type(lvar(_), _) :-
	error("lvar unexpected in llds__lval_type").
llds__lval_type(mem_ref(_), word).

llds__rval_type(lval(Lval), Type) :-
	llds__lval_type(Lval, Type).
llds__rval_type(var(_), _) :-
	error("var unexpected in llds__rval_type").
llds__rval_type(create(_, _, _, _, _, _), data_ptr).
	%
	% Note that create and mkword must both be of type data_ptr,
	% not of type word, to ensure that static consts containing
	% them get type `const Word *', not type `Word'; this is
	% necessary because casts from pointer to int must not be used
	% in the initializers for constant expressions -- if they are,
	% then lcc barfs, and gcc generates bogus code on some systems,
	% (e.g. IRIX with shared libs).  If the second argument to mkword
	% is an integer, not a pointer, then we will end up casting it
	% to a pointer, but casts from integer to pointer are OK, it's
	% only the reverse direction we need to avoid.
	%
llds__rval_type(mkword(_, _), data_ptr).
llds__rval_type(const(Const), Type) :-
	llds__const_type(Const, Type).
llds__rval_type(unop(UnOp, _), Type) :-
	llds__unop_return_type(UnOp, Type).
llds__rval_type(binop(BinOp, _, _), Type) :-
	llds__binop_return_type(BinOp, Type).
llds__rval_type(mem_addr(_), data_ptr).

llds__const_type(true, bool).
llds__const_type(false, bool).
llds__const_type(int_const(_), integer).
llds__const_type(float_const(_), float).
llds__const_type(string_const(_), data_ptr).
llds__const_type(multi_string_const(_, _), data_ptr).
llds__const_type(code_addr_const(_), code_ptr).
llds__const_type(data_addr_const(_), data_ptr).
llds__const_type(label_entry(_), code_ptr).

llds__unop_return_type(mktag, word).
llds__unop_return_type(tag, word).
llds__unop_return_type(unmktag, word).
llds__unop_return_type(mkbody, word).
llds__unop_return_type(unmkbody, word).
llds__unop_return_type(body, word).
llds__unop_return_type(cast_to_unsigned, unsigned).
llds__unop_return_type(hash_string, integer).
llds__unop_return_type(bitwise_complement, integer).
llds__unop_return_type(not, bool).

llds__unop_arg_type(mktag, word).
llds__unop_arg_type(tag, word).
llds__unop_arg_type(unmktag, word).
llds__unop_arg_type(mkbody, word).
llds__unop_arg_type(unmkbody, word).
llds__unop_arg_type(body, word).
llds__unop_arg_type(cast_to_unsigned, word).
llds__unop_arg_type(hash_string, word).
llds__unop_arg_type(bitwise_complement, integer).
llds__unop_arg_type(not, bool).

llds__binop_return_type((+), integer).
llds__binop_return_type((-), integer).
llds__binop_return_type((*), integer).
llds__binop_return_type((/), integer).
llds__binop_return_type((mod), integer).
llds__binop_return_type((<<), integer).
llds__binop_return_type((>>), integer).
llds__binop_return_type((&), integer).
llds__binop_return_type(('|'), integer).
llds__binop_return_type((^), integer).
llds__binop_return_type((and), bool).
llds__binop_return_type((or), bool).
llds__binop_return_type(eq, bool).
llds__binop_return_type(ne, bool).
llds__binop_return_type(array_index, word).
llds__binop_return_type(str_eq, bool).
llds__binop_return_type(str_ne, bool).
llds__binop_return_type(str_lt, bool).
llds__binop_return_type(str_gt, bool).
llds__binop_return_type(str_le, bool).
llds__binop_return_type(str_ge, bool).
llds__binop_return_type((<), bool).
llds__binop_return_type((>), bool).
llds__binop_return_type((<=), bool).
llds__binop_return_type((>=), bool).
llds__binop_return_type(float_plus, float).
llds__binop_return_type(float_minus, float).
llds__binop_return_type(float_times, float).
llds__binop_return_type(float_divide, float).
llds__binop_return_type(float_eq, bool).
llds__binop_return_type(float_ne, bool).
llds__binop_return_type(float_lt, bool).
llds__binop_return_type(float_gt, bool).
llds__binop_return_type(float_le, bool).
llds__binop_return_type(float_ge, bool).

llds__register_type(r, word).
llds__register_type(f, float).

llds__all_args_are_word_size(uniform(MaybeType), AllWordSize) :-
	llds__maybe_type_is_word_size(MaybeType, AllWordSize).
llds__all_args_are_word_size(initial(Init, Rest), AllWordSize) :-
	assoc_list__values(Init, MaybeTypes),
	list__map(llds__maybe_type_is_word_size, MaybeTypes, InitWordSizes),
	llds__all_args_are_word_size(Rest, RestWordSize),
	bool__and_list([RestWordSize | InitWordSizes], AllWordSize).
llds__all_args_are_word_size(none, yes).

:- pred llds__maybe_type_is_word_size(maybe(llds_type)::in, bool::out) is det.

llds__maybe_type_is_word_size(no, yes).
llds__maybe_type_is_word_size(yes(Type), IsWordSize) :-
	llds__type_is_word_size_as_arg(Type, IsWordSize).

llds__type_is_word_size_as_arg(int_least8,   no).
llds__type_is_word_size_as_arg(uint_least8,  no).
llds__type_is_word_size_as_arg(int_least16,  no).
llds__type_is_word_size_as_arg(uint_least16, no).
llds__type_is_word_size_as_arg(int_least32,  no).
llds__type_is_word_size_as_arg(uint_least32, no).
llds__type_is_word_size_as_arg(bool,         yes).
llds__type_is_word_size_as_arg(integer,      yes).
llds__type_is_word_size_as_arg(unsigned,     yes).
llds__type_is_word_size_as_arg(float,        yes).
llds__type_is_word_size_as_arg(string,       yes).
llds__type_is_word_size_as_arg(data_ptr,     yes).
llds__type_is_word_size_as_arg(code_ptr,     yes).
llds__type_is_word_size_as_arg(word,         yes).

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- type proc_var_map	==	map(pred_proc_id, comp_gen_c_var).
:- type proc_layout_map	==	map(pred_proc_id, proc_layout_info).

:- type global_data
	--->	global_data(
			proc_var_map,		% Information about the global
						% variables defined by each
						% procedure.
			proc_layout_map,	% Information about the
						% layout structures defined
						% by each procedure.
			list(comp_gen_c_data)	% The list of global data
						% structures that do not need
						% to be checked by llds_common,
						% because their construction
						% ensures no overlaps.
		).

global_data_init(global_data(EmptyDataMap, EmptyLayoutMap, [])) :-
	map__init(EmptyDataMap),
	map__init(EmptyLayoutMap).

global_data_add_new_proc_var(GlobalData0, PredProcId, ProcVar,
		GlobalData) :-
	global_data_get_proc_var_map(GlobalData0, ProcVarMap0),
	map__det_insert(ProcVarMap0, PredProcId, ProcVar, ProcVarMap),
	global_data_set_proc_var_map(GlobalData0, ProcVarMap,
		GlobalData).

global_data_add_new_proc_layout(GlobalData0, PredProcId, ProcLayout,
		GlobalData) :-
	global_data_get_proc_layout_map(GlobalData0, ProcLayoutMap0),
	map__det_insert(ProcLayoutMap0, PredProcId, ProcLayout, ProcLayoutMap),
	global_data_set_proc_layout_map(GlobalData0, ProcLayoutMap,
		GlobalData).

global_data_update_proc_layout(GlobalData0, PredProcId, ProcLayout,
		GlobalData) :-
	global_data_get_proc_layout_map(GlobalData0, ProcLayoutMap0),
	map__det_update(ProcLayoutMap0, PredProcId, ProcLayout, ProcLayoutMap),
	global_data_set_proc_layout_map(GlobalData0, ProcLayoutMap,
		GlobalData).

global_data_add_new_non_common_static_datas(GlobalData0, NewNonCommonStatics,
		GlobalData) :-
	global_data_get_non_common_static_data(GlobalData0, NonCommonStatics0),
	list__append(NewNonCommonStatics, NonCommonStatics0, NonCommonStatics),
	global_data_set_non_common_static_data(GlobalData0, NonCommonStatics,
		GlobalData).

global_data_maybe_get_proc_layout(GlobalData0, PredProcId, ProcLayout) :-
	global_data_get_proc_layout_map(GlobalData0, ProcLayoutMap),
	map__search(ProcLayoutMap, PredProcId, ProcLayout).

global_data_get_proc_layout(GlobalData0, PredProcId, ProcLayout) :-
	global_data_get_proc_layout_map(GlobalData0, ProcLayoutMap),
	map__lookup(ProcLayoutMap, PredProcId, ProcLayout).

global_data_get_all_proc_vars(GlobalData, ProcVars) :-
	global_data_get_proc_var_map(GlobalData, ProcVarMap),
	map__values(ProcVarMap, ProcVars).

global_data_get_all_proc_layouts(GlobalData, ProcLayouts) :-
	global_data_get_proc_layout_map(GlobalData, ProcLayoutMap),
	map__values(ProcLayoutMap, ProcLayouts).

global_data_get_all_non_common_static_data(GlobalData, NonCommonStatics) :-
	global_data_get_non_common_static_data(GlobalData, NonCommonStatics).

%-----------------------------------------------------------------------------%

:- pred global_data_get_proc_var_map(global_data::in, proc_var_map::out)
	is det.
:- pred global_data_get_proc_layout_map(global_data::in, proc_layout_map::out)
	is det.
:- pred global_data_get_non_common_static_data(global_data::in,
	list(comp_gen_c_data)::out) is det.
:- pred global_data_set_proc_var_map(global_data::in, proc_var_map::in,
	global_data::out) is det.
:- pred global_data_set_proc_layout_map(global_data::in, proc_layout_map::in,
	global_data::out) is det.
:- pred global_data_set_non_common_static_data(global_data::in,
	list(comp_gen_c_data)::in, global_data::out) is det.

global_data_get_proc_var_map(GD, A) :-
	GD = global_data(A, _, _).

global_data_get_proc_layout_map(GD, B) :-
	GD = global_data(_, B, _).

global_data_get_non_common_static_data(GD, C) :-
	GD = global_data(_, _, C).

global_data_set_proc_var_map(GD0, A, GD) :-
	GD0 = global_data(_, B, C),
	GD  = global_data(A, B, C).

global_data_set_proc_layout_map(GD0, B, GD) :-
	GD0 = global_data(A, _, C),
	GD  = global_data(A, B, C).

global_data_set_non_common_static_data(GD0, C, GD) :-
	GD0 = global_data(A, B, _),
	GD  = global_data(A, B, C).

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%