Alien-LibJIT

 view release on metacpan or  search on metacpan

libjit/dpas/dpas-parser.y  view on Meta::CPAN

			else
			{
				/* TODO: type checking */
				if(dpas_sem_is_rvalue(args[param]))
				{
					value_args[param] = dpas_sem_get_value
						(dpas_lvalue_to_rvalue(args[param]));
				}
				else
				{
					dpas_error("invalid value for parameter %d",
							   (int)(param + 1));
					error = 1;
				}
			}
		}
	}
	else
	{
		value_args = 0;
	}
	if(error)
	{
		jit_free(value_args);
		dpas_sem_set_error(rvalue);
		return rvalue;
	}

	/* Call the specified procedure or function */
	if(func_value)
	{
		return_value = jit_insn_call
			(func, name, func_value, signature,
			 value_args, (unsigned int)num_args, 0);
	}
	else
	{
		return_value = jit_insn_call_indirect
			(func, indirect_value, signature,
			 value_args, (unsigned int)num_args, 0);
	}
	if(!return_value)
	{
		dpas_out_of_memory();
	}
	jit_free(value_args);

	/* Construct a semantic value object for the return value */
	type = jit_type_get_return(signature);
	if(type == jit_type_void)
	{
		dpas_sem_set_void(rvalue);
	}
	else
	{
		dpas_sem_set_rvalue(rvalue, type, return_value);
	}
	return rvalue;
}

static int throw_builtin_exception(jit_function_t func, int exception_type)
{
	jit_type_t signature;
	jit_type_t param_types[1];
	jit_value_t param_values[1];

	/* Call the "jit_exception_builtin" function to report the exception */
	param_types[0] = jit_type_int;
	signature = jit_type_create_signature
		(jit_abi_cdecl, jit_type_void, param_types, 1, 1);
	if(!signature)
	{
		return 0;
	}

	param_values[0] = jit_value_create_nint_constant(func, jit_type_int, exception_type);
	if(!param_values[0])
	{
		return 0;
	}
	jit_insn_call_native
		(func, "jit_exception_builtin",
		 (void *)jit_exception_builtin, signature, param_values, 1,
		 JIT_CALL_NORETURN);
	jit_type_free(signature);

	return 1;
}

/*
 * Handle a numeric binary operator.
 */
#define	handle_binary(name,func,arg1,arg2)	\
		do { \
			if(!dpas_sem_is_rvalue(arg1) || \
			   !dpas_type_is_numeric(dpas_sem_get_type(arg2)) || \
			   !dpas_sem_is_rvalue(arg1) || \
			   !dpas_type_is_numeric(dpas_sem_get_type(arg2))) \
			{ \
				if(!dpas_sem_is_error(arg1) && !dpas_sem_is_error(arg2)) \
				{ \
					dpas_error("invalid operands to binary `" name "'"); \
				} \
				dpas_sem_set_error(yyval.semvalue); \
			} \
			else \
			{ \
				jit_value_t value; \
				value = func \
					(dpas_current_function(), \
					 dpas_sem_get_value(dpas_lvalue_to_rvalue(arg1)), \
					 dpas_sem_get_value(dpas_lvalue_to_rvalue(arg2))); \
				dpas_sem_set_rvalue \
					(yyval.semvalue, jit_value_get_type(value), value); \
			} \
		} while (0)

/*
 * Handle an integer binary operator.
 */
#define	handle_integer_binary(name,func,arg1,arg2)	\

libjit/dpas/dpas-parser.y  view on Meta::CPAN

	struct
	{
		dpas_semvalue *exprs;
		int			len;
	}				expr_list;
	int				direction;
	jit_abi_t		abi;
}

/*
 * Primitive lexical tokens.
 */
%token IDENTIFIER			"an identifier"
%token INTEGER_CONSTANT		"an integer value"
%token STRING_CONSTANT		"a string literal"
%token REAL_CONSTANT		"a floating point value"

/*
 * Keywords.
 */
%token K_AND				"`and'"
%token K_ARRAY				"`array'"
%token K_BEGIN				"`begin'"
%token K_CASE				"`case'"
%token K_CATCH				"`catch'"
%token K_CONST				"`const'"
%token K_DIV				"`div'"
%token K_DO					"`do'"
%token K_DOWNTO				"`downto'"
%token K_ELSE				"`else'"
%token K_END				"`end'"
%token K_EXIT				"`exit'"
%token K_FASTCALL			"`fastcall'"
%token K_FINALLY			"`finally'"
%token K_FOR				"`for'"
%token K_FORWARD			"`forward'"
%token K_FUNCTION			"`function'"
%token K_GOTO				"`goto'"
%token K_IF					"`if'"
%token K_IN					"`in'"
%token K_LABEL				"`label'"
%token K_IMPORT				"`import'"
%token K_MOD				"`mod'"
%token K_MODULE				"`module'"
%token K_NIL				"`nil'"
%token K_NOT				"`not'"
%token K_OF					"`of'"
%token K_OR					"`or'"
%token K_PACKED				"`packed'"
%token K_POW				"`pow'"
%token K_PROCEDURE			"`procedure'"
%token K_PROGRAM			"`program'"
%token K_RECORD				"`record'"
%token K_REPEAT				"`repeat'"
%token K_SET				"`set'"
%token K_SHL				"`shl'"
%token K_SHR				"`shr'"
%token K_SIZEOF				"`sizeof'"
%token K_STDCALL			"`stdcall'"
%token K_THEN				"`then'"
%token K_THROW				"`throw'"
%token K_TO					"`to'"
%token K_TRY				"`try'"
%token K_TYPE				"`type'"
%token K_UNTIL				"`until'"
%token K_VAR				"`var'"
%token K_VA_ARG				"`va_arg'"
%token K_WITH				"`with'"
%token K_WHILE				"`while'"
%token K_XOR				"`xor'"

/*
 * Operators.
 */
%token K_NE					"`<>'"
%token K_LE					"`<='"
%token K_GE					"`>='"
%token K_ASSIGN				"`:='"
%token K_DOT_DOT			"`..'"

/*
 * Define the yylval types of the various non-terminals.
 */
%type <name>				IDENTIFIER STRING_CONSTANT Identifier Directive
%type <int_const>			INTEGER_CONSTANT
%type <real_const>			REAL_CONSTANT
%type <const_value>			Constant ConstantValue BasicConstant
%type <id_list>				IdentifierList
%type <type_list>			ArrayBoundsList VariantCaseList

%type <type>				Type TypeIdentifier SimpleType StructuredType
%type <type>				BoundType Variant VariantList

%type <param_type>			ParameterType ConformantArray

%type <parameters>			FormalParameterList FormalParameterSection
%type <parameters>			FormalParameterSections FieldList FixedPart
%type <parameters>			RecordSection VariantPart BoundSpecificationList
%type <parameters>			BoundSpecification

%type <procedure>			ProcedureHeading FunctionHeading
%type <procedure>			ProcedureOrFunctionHeading

%type <semvalue>			Variable Expression SimpleExpression
%type <semvalue>			AdditionExpression Term Factor Power
%type <semvalue>			BooleanExpression AssignmentStatement

%type <expr_list>			ExpressionList ActualParameters

%type <direction>			Direction

%type <abi>					OptAbi

%expect 3

%start Program
%%

/*
 * Programs.
 */

libjit/dpas/dpas-parser.y  view on Meta::CPAN

	| StatementSequence ';' Statement
	;

Statement
	: Label ':' InnerStatement
	| InnerStatement
	;

InnerStatement
	: AssignmentStatement			{ /* Nothing to do here */ }
	| Variable ActualParameters		{
				/* Call a procedure or an ignored-result function */
				if(dpas_sem_is_builtin($1))
				{
					/* Expand a call to a builtin procedure */
					dpas_expand_builtin
						(dpas_sem_get_builtin($1), $2.exprs, $2.len);
				}
				else if(dpas_sem_is_procedure($1))
				{
					/* Invoke a user-defined procedure */
					dpas_scope_item_t item = dpas_sem_get_procedure($1);
					invoke_procedure
						((jit_function_t)dpas_scope_item_info(item),
						 dpas_scope_item_name(item),
						 dpas_scope_item_type(item), 0, $2.exprs, $2.len);
				}
				else if(dpas_sem_is_rvalue($1) &&
						jit_type_is_signature(dpas_sem_get_type($1)))
				{
					/* Invoke a procedure via an indirect pointer */
					invoke_procedure
						(0, 0, dpas_sem_get_type($1), dpas_sem_get_value($1),
						 $2.exprs, $2.len);
				}
				else
				{
					if(!dpas_sem_is_error($1))
					{
						dpas_error("invalid function or procedure name");
					}
				}
				expression_list_free($2.exprs, $2.len);
			}
	| K_GOTO Label		{
				/* TODO */
				dpas_error("`goto' statements not yet implemented");
			}
	| CompoundStatement
	| IfStatement
	| WhileStatement
	| RepeatStatement
	| ForStatement
	| CaseStatement
	| K_WITH VariableList K_DO Statement	{
				/* TODO */
				dpas_error("`with' statements not yet implemented");
			}
	| K_THROW Expression		{
				/* TODO */
				dpas_error("`throw' statements not yet implemented");
			}
	| K_THROW					{
				/* TODO */
				dpas_error("`throw' statements not yet implemented");
			}
	| TryStatement
	| K_EXIT		{
				/* Exit from the current loop level */
				if(loop_stack_size > 0)
				{
					if(!jit_insn_branch
						(dpas_current_function(),
						 &(loop_stack[loop_stack_size - 1].exit_label)))
					{
						dpas_out_of_memory();
					}
				}
				else
				{
					dpas_error("`exit' used outside loop");
				}
			}
	;

ActualParameters
	: /* empty */				{ $$.exprs = 0; $$.len = 0; }
	| '(' ExpressionList ')'	{ $$ = $2; }
	;

CompoundStatement
	: K_BEGIN StatementSequence OptSemi K_END
	| K_BEGIN error K_END
	;

AssignmentStatement
	: Variable K_ASSIGN Expression			{
				jit_type_t ltype;
				jit_type_t rtype;
				jit_value_t dest;
				jit_value_t value;

				/* Convert variable references to the current function
				   into function return semantic values */
				if(dpas_sem_is_procedure($1) &&
				   ((jit_function_t)dpas_scope_item_info
				   			(dpas_sem_get_procedure($1))) ==
						dpas_current_function())
				{
					dpas_sem_set_return
						($1, jit_type_get_return(dpas_sem_get_type($1)));
				}

				/* Validate the l-value expression */
				if(!dpas_sem_is_lvalue($1) && !dpas_sem_is_lvalue_ea($1) &&
				   !dpas_sem_is_return($1))
				{
					if(!dpas_sem_is_error($1))
					{
						dpas_error("invalid l-value in assignment statement");
					}
					ltype = jit_type_void;
				}
				else
				{

libjit/dpas/dpas-parser.y  view on Meta::CPAN


						/* get values for upper and lower bounds */
						if ( bounds )
						{
							/* bounds can be either subrange or tagged */
							if ( jit_type_get_tagged_kind(bounds[i]) == DPAS_TAG_SUBRANGE )
							{
								upper_bound = jit_value_create_nint_constant(func,jit_type_int,
										((dpas_subrange *)jit_type_get_tagged_data(bounds[i]))->last.un.int_value);
								lower_bound = jit_value_create_nint_constant(func,jit_type_int,
										((dpas_subrange *)jit_type_get_tagged_data(bounds[i]))->first.un.int_value);
							}
							else if ( jit_type_get_tagged_kind(bounds[i]) == DPAS_TAG_ENUM )
							{
								upper_bound = jit_value_create_nint_constant(func,jit_type_int,
										((dpas_enum *)jit_type_get_tagged_data(bounds[i]))->num_elems-1);
								lower_bound = jit_value_create_nint_constant(func,jit_type_int,0);
							}

							/* check the upper bound first */
							temp1 = jit_insn_le(func,index,upper_bound);
							/* jump if not less than or equal to out_of_bounds */
							jit_insn_branch_if_not(func,temp1,&out_of_bounds);
							/* fall through if it is less than or equal */

							/* compute difference = index - lower_bound and check greater than 0 
								 so that we can re-use it */
							difference = jit_insn_sub(func,index,lower_bound);

							temp2 = jit_insn_ge(func,difference,zero);
							/* jump if not greater than or equal to out_of_bounds */
							jit_insn_branch_if_not(func,temp2,&out_of_bounds);
							/* fall through if greater than or equal */

							/* create a constant_value for the factor(range_size) */
							factor = jit_value_create_nint_constant(func,jit_type_uint,range_size);

							/* offset = difference * factor */
							offset = jit_insn_mul(func,difference,factor);

							/* total_offset += offset */
							total_offset = jit_insn_add(func,total_offset,offset);

							/*compute the range size for the next dimension */
							range_size *= (jit_value_get_nint_constant(upper_bound) - 
										(jit_value_get_nint_constant(lower_bound) -1));
						}
						else
						{
							/* no bounds are available, so it must be a pointer access */
							jit_insn_store(func,total_offset,index);
						}
					}

					if ( bounds )
					{
						/* if anything went wrong in the loop, we would be in out_of_bounds. 
							 so jump to all_is_well */
						jit_insn_branch(func,&all_is_well);

						/* if we are here, out_of_bounds, throw an exception */
						jit_insn_label(func,&out_of_bounds);

						throw_builtin_exception(func, JIT_RESULT_OUT_OF_BOUNDS);

						/* if we we are here, all_is_well */
						jit_insn_label(func,&all_is_well);
					}

					/* compute effective address and set lvalue_ea*/
					lvalue_ea = jit_insn_load_elem_address(func,array,total_offset,elem_type);
					dpas_sem_set_lvalue_ea($$,elem_type,lvalue_ea);

					/* clean-up : we aren't allocating anything here */
				}
				else
				{
					dpas_error("invalid l-value supplied to array expression");
					dpas_sem_set_error($$);
				}
				expression_list_free($3.exprs, $3.len);
			}
	| Variable '.' Identifier			{
				/* Fetch the effective address of a record field */
				jit_type_t type = dpas_sem_get_type($1);
				jit_type_t field_type;
				jit_value_t address;
				jit_nint offset;
				if(dpas_sem_is_lvalue_ea($1))
				{
					address = dpas_sem_get_value($1);
				}
				else if(dpas_sem_is_lvalue($1))
				{
					address = jit_insn_address_of
						(dpas_current_function(), dpas_sem_get_value($1));
					if(!address)
					{
						dpas_out_of_memory();
					}
				}
				else
				{
					if(!dpas_sem_is_error($1))
					{
						dpas_error("invalid left hand side for `.'");
					}
					type = 0;
					address = 0;
				}
				if(type && dpas_type_is_record(type))
				{
					field_type = dpas_type_get_field(type, $3, &offset);
					if(field_type)
					{
						if(offset != 0)
						{
							address = jit_insn_add_relative
								(dpas_current_function(), address, offset);
							if(!address)
							{
								dpas_out_of_memory();
							}
						}



( run in 0.576 second using v1.01-cache-2.11-cpan-119454b85a5 )