Subversion Repositories tendra.SVN

Rev

Rev 6 | Blame | Compare with Previous | Last modification | View Log | RSS feed

/*
 * Copyright (c) 2002-2005 The TenDRA Project <http://www.tendra.org/>.
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are met:
 *
 * 1. Redistributions of source code must retain the above copyright notice,
 *    this list of conditions and the following disclaimer.
 * 2. Redistributions in binary form must reproduce the above copyright notice,
 *    this list of conditions and the following disclaimer in the documentation
 *    and/or other materials provided with the distribution.
 * 3. Neither the name of The TenDRA Project nor the names of its contributors
 *    may be used to endorse or promote products derived from this software
 *    without specific, prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS
 * IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
 * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
 * PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR
 * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
 * EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *
 * $Id$
 */
/*
                 Crown Copyright (c) 1997

    This TenDRA(r) Computer Program is subject to Copyright
    owned by the United Kingdom Secretary of State for Defence
    acting through the Defence Evaluation and Research Agency
    (DERA).  It is made available to Recipients with a
    royalty-free licence for its use, reproduction, transfer
    to other parties and amendment for any purpose not excluding
    product development provided that any such use et cetera
    shall be deemed to be acceptance of the following conditions:-

        (1) Its Recipients shall ensure that this Notice is
        reproduced upon any copies or amended versions of it;

        (2) Any amended version of it shall be clearly marked to
        show both the nature of and the organisation responsible
        for the relevant amendment or amendments;

        (3) Its onward transfer from a recipient to another
        party shall be deemed to be that party's acceptance of
        these conditions;

        (4) DERA gives no warranty or assurance as to its
        quality or suitability for any purpose and DERA accepts
        no liability whatsoever in relation to any use to which
        it may be put.
*/


/*
    SHAPE CHECKING MACRO DEFINITIONS

    This file contains the definitions for the shape checking macros
    generated in check_exp.h.
*/

#if FS_TENDRA
#define UNUSED_ARG(A)                   UNUSED(A)
#else
#define UNUSED_ARG(A)                   ((void)(A))
#endif

#define CHECK_exp_apply_token           chk_token(exp);

#define CHECK_exp_cond\
        IGNORE check1(ENC_integer, control);\
        chk_cond(exp);

#define CHECK_abs                       CHECK_negate

#define CHECK_add_to_ptr\
        node *sh1 = check1(ENC_pointer, arg1);\
        node *sh2 = check1(ENC_offset, arg2);\
        al_includes(ptr_to(sh1), offset_from(sh2));\
        exp->shape = sh_pointer(offset_to(sh2));

#define CHECK_and\
        exp->shape = normalize(check2(ENC_integer, arg1, arg2));

#define CHECK_apply_proc\
        exp->shape = normalize(result_shape);\
        IGNORE check1(ENC_proc, p);\
        UNUSED_ARG(params);\
        UNUSED_ARG(var_param);

#define CHECK_apply_general_proc\
        exp->shape = normalize(result_shape);\
        IGNORE check1(ENC_proc, p);\
        UNUSED_ARG(postlude);

#define CHECK_assign\
        node *sh1 = check1(ENC_pointer, arg1);\
        al_includes(ptr_to(sh1), al_shape(arg2));\
        exp->shape = sh_top;

#define CHECK_assign_with_mode          CHECK_assign

#define CHECK_bitfield_assign\
        node *sh1 = check1(ENC_pointer, arg1);\
        node *sh2 = check1(ENC_offset, arg2);\
        node *sh3 = check1(ENC_bitfield, arg3);\
        al_includes(ptr_to(sh1), offset_from(sh2));\
        al_includes(offset_to(sh2), al_shape(sh3));\
        exp->shape = sh_top;

#define CHECK_bitfield_assign_with_mode CHECK_bitfield_assign

#define CHECK_bitfield_contents\
        node *sh = sh_bitfield(v);\
        node *sh1 = check1(ENC_pointer, arg1);\
        node *sh2 = check1(ENC_offset, arg2);\
        al_includes(ptr_to(sh1), offset_from(sh2));\
        al_includes(offset_to(sh2), al_shape(sh));\
        exp->shape = sh;

#define CHECK_bitfield_contents_with_mo CHECK_bitfield_contents

#define CHECK_case\
        IGNORE check1(ENC_integer, control);\
        if (exhaustive && exhaustive->cons->encoding == ENC_true) {\
            exp->shape = sh_bottom ;\
        } else {\
            exp->shape = sh_top ;\
        }

#define CHECK_change_bitfield_to_int\
        exp->shape = sh_integer(v);\
        IGNORE check1(ENC_bitfield, arg1);

#define CHECK_change_floating_variety\
        exp->shape = sh_floating(r);\
        IGNORE check1(ENC_floating, arg1);

#define CHECK_change_variety\
        exp->shape = sh_integer(r);\
        IGNORE check1(ENC_integer, arg1);

#define CHECK_change_int_to_bitfield\
        exp->shape = sh_bitfield(bv);\
        IGNORE check1(ENC_integer, arg1);

#define CHECK_complex_conjugate\
        exp->shape = normalize(c->shape);

#define CHECK_component\
        exp->shape = normalize(sha);\
        IGNORE check1(ENC_compound, arg1);\
        IGNORE check1(ENC_offset, arg2);

#define CHECK_concat_nof\
        exp->shape = normalize(check2(ENC_nof, arg1, arg2));

#define CHECK_conditional\
        exp->shape = normalize(lub(first->shape, alt->shape));

#define CHECK_contents\
        node *sh1 = check1(ENC_pointer, arg1);\
        al_includes(ptr_to(sh1), al_shape(s));\
        exp->shape = normalize(s);

#define CHECK_contents_with_mode        CHECK_contents

#define CHECK_current_env\
        exp->shape = sh_pointer(al_frame);

#define CHECK_div0                      CHECK_and

#define CHECK_div1                      CHECK_and

#define CHECK_div2                      CHECK_and

#define CHECK_env_offset\
        exp->shape = sh_offset(fa, y);\
        chk_tag(exp, t, 0);

#define CHECK_env_size\
        exp->shape = sh_offset(al_frame, al_top);\
        IGNORE check1(ENC_proc, proctag);

#define CHECK_fail_installer\
        exp->shape = sh_bottom ;\
        UNUSED_ARG(message);

#define CHECK_float_int\
        exp->shape = sh_floating(f);\
        IGNORE check1(ENC_integer, arg1);

#define CHECK_floating_abs\
        exp->shape = normalize(check1(ENC_floating, arg1));

#define CHECK_floating_div\
        exp->shape = normalize(check2(ENC_floating, arg1, arg2));

#define CHECK_floating_minus            CHECK_floating_div

#define CHECK_floating_maximum          CHECK_floating_div

#define CHECK_floating_minimum          CHECK_floating_div

#define CHECK_floating_mult\
        exp->shape = normalize(checkn(ENC_floating, arg1, 1));

#define CHECK_floating_negate           CHECK_floating_abs

#define CHECK_floating_plus             CHECK_floating_mult

#define CHECK_floating_power\
        exp->shape = normalize(check1(ENC_floating, arg1));\
        IGNORE check1(ENC_integer, arg2);

#define CHECK_floating_test\
        exp->shape = sh_top ;\
        IGNORE check2(ENC_floating, arg1, arg2);

#define CHECK_goto                      exp->shape = sh_bottom;

#define CHECK_goto_local_lv\
        exp->shape = sh_bottom ;\
        IGNORE check1(ENC_pointer, arg1);

#define CHECK_identify\
        exp->shape = normalize(body->shape);\
        chk_tag(exp, name_intro, 1);\
        UNUSED_ARG(definition);

#define CHECK_ignorable\
        exp->shape = normalize(arg1->shape);

#define CHECK_imaginary_part\
        exp->shape = null ;\
        UNUSED_ARG(arg1);

#define CHECK_initial_value\
        exp->shape = normalize(init->shape);

#define CHECK_integer_test\
        exp->shape = sh_top ;\
        IGNORE check2(ENC_integer, arg1, arg2);

#define CHECK_labelled\
        node *sh = starter->shape ;\
        node *place = places->son ;\
        while (place) {\
            sh = lub(sh, place->shape);\
            place = place->bro ;\
        }\
        exp->shape = normalize(sh);

#define CHECK_last_local\
        exp->shape = sh_pointer(al_alloca);\
        IGNORE check1(ENC_offset, x);

#define CHECK_local_alloc\
        exp->shape = sh_pointer(al_alloca);\
        IGNORE check1(ENC_offset, arg1);

#define CHECK_local_alloc_check         CHECK_local_alloc

#define CHECK_local_free\
        exp->shape = sh_top ;\
        IGNORE check1(ENC_offset, a);\
        IGNORE check1(ENC_pointer, p);

#define CHECK_local_free_all            exp->shape = sh_top;

#define CHECK_long_jump\
        exp->shape = sh_bottom ;\
        IGNORE check1(ENC_pointer, arg1);\
        IGNORE check1(ENC_pointer, arg2);

#define CHECK_make_complex\
        exp->shape = sh_floating(c);\
        IGNORE check1(ENC_floating, arg1);\
        IGNORE check1(ENC_floating, arg2);

#define CHECK_make_compound\
        exp->shape = sh_compound(arg1);\
        IGNORE check1(ENC_offset, arg1);\
        UNUSED_ARG(arg2);

#define CHECK_make_floating\
        exp->shape = sh_floating(f);\
        UNUSED_ARG(base);\
        UNUSED_ARG(mantissa);\
        UNUSED_ARG(negative);

#define CHECK_make_general_proc\
        exp->shape = sh_proc ;\
        IGNORE check1(ENC_bottom, body);\
        UNUSED_ARG(result_shape);

#define CHECK_make_int                  exp->shape = sh_integer(v);

#define CHECK_make_local_lv             exp->shape = sh_pointer(al_code);

#define CHECK_make_nof\
        long ns = arg1->cons->encoding ;\
        node *sh = checkn(ENC_shape_none, arg1, 0);\
        if (sh)exp->shape = sh_nof(make_nat(ns), sh);

#define CHECK_make_nof_int\
        node *sh = sh_integer(v);\
        exp->shape = sh_nof(string_length(str), sh);

#define CHECK_make_null_local_lv        exp->shape = sh_pointer(al_code);

#define CHECK_make_null_proc            exp->shape = sh_proc;

#define CHECK_make_null_ptr             exp->shape = sh_pointer(a);

#define CHECK_make_proc\
        exp->shape = sh_proc ;\
        IGNORE check1(ENC_bottom, body);\
        UNUSED_ARG(result_shape);

#define CHECK_make_stack_limit\
        exp->shape = null ;\
        UNUSED_ARG(stack_base);\
        UNUSED_ARG(frame_size);\
        UNUSED_ARG(alloc_size);

#define CHECK_make_top                  exp->shape = sh_top;

#define CHECK_make_value                exp->shape = normalize(s);

#define CHECK_maximum                   CHECK_and

#define CHECK_minimum                   CHECK_and

#define CHECK_minus                     CHECK_and

#define CHECK_move_some\
        node *sh1 = check1(ENC_pointer, arg1);\
        node *sh2 = check1(ENC_pointer, arg2);\
        node *sh3 = check1(ENC_offset, arg3);\
        al_includes(ptr_to(sh1), offset_from(sh3));\
        al_includes(ptr_to(sh2), offset_to(sh3));\
        exp->shape = sh_top;

#define CHECK_mult                      CHECK_and

#define CHECK_n_copies\
        exp->shape = sh_nof(n, arg1->shape);

#define CHECK_negate\
        exp->shape = normalize(check1(ENC_integer, arg1));

#define CHECK_not                       CHECK_negate

#define CHECK_obtain_tag                chk_tag(exp, t, 0);

#define CHECK_offset_add\
        node *sh1 = check1(ENC_offset, arg1);\
        node *sh2 = check1(ENC_offset, arg2);\
        al_includes(offset_to(sh1), offset_from(sh2));\
        exp->shape = sh_offset(offset_from(sh1), offset_to(sh2));

#define CHECK_offset_div\
        node *sh = check2(ENC_offset, arg1, arg2);\
        al_equals(offset_from(sh), offset_to(sh));\
        exp->shape = sh_integer(v);

#define CHECK_offset_div_by_int\
        node *sh1 = check1(ENC_offset, arg1);\
        al_equals(offset_from(sh1), offset_to(sh1));\
        IGNORE check1(ENC_integer, arg2);\
        exp->shape = normalize(sh1);

#define CHECK_offset_max\
        node *sh1 = check1(ENC_offset, arg1);\
        node *sh2 = check1(ENC_offset, arg2);\
        node *al1 = al_union(offset_from(sh1), offset_from(sh2));\
        node *al2 = offset_to(sh1);\
        al_equals(al2, offset_to(sh2));\
        exp->shape = sh_offset(al1, al2);

#define CHECK_offset_mult\
        node *sh1 = check1(ENC_offset, arg1);\
        al_equals(offset_from(sh1), offset_to(sh1));\
        IGNORE check1(ENC_integer, arg2);\
        exp->shape = normalize(sh1);

#define CHECK_offset_negate\
        node *sh1 = check1(ENC_offset, arg1);\
        al_equals(offset_from(sh1), offset_to(sh1));\
        exp->shape = normalize(sh1);

#define CHECK_offset_pad\
        node *sh1 = check1(ENC_offset, arg1);\
        node *al1 = al_union(offset_from(sh1), a);\
        exp->shape = sh_offset(al1, offset_to(sh1));

#define CHECK_offset_subtract\
        node *sh1 = check1(ENC_offset, arg1);\
        node *sh2 = check1(ENC_offset, arg2);\
        al_equals(offset_from(sh1), offset_from(sh2));\
        exp->shape = sh_offset(offset_to(sh1), offset_to(sh2));

#define CHECK_offset_test\
        exp->shape = sh_top ;\
        IGNORE check2(ENC_offset, arg1, arg2);

#define CHECK_offset_zero               exp->shape = sh_offset(a, a);

#define CHECK_or                        CHECK_and

#define CHECK_plus                      CHECK_and

#define CHECK_pointer_test\
        exp->shape = sh_top ;\
        IGNORE check2(ENC_pointer, arg1, arg2);

#define CHECK_power                     CHECK_shift_left

#define CHECK_proc_test\
        exp->shape = sh_top ;\
        IGNORE check2(ENC_proc, arg1, arg2);

#define CHECK_profile\
        exp->shape = sh_top ;\
        UNUSED_ARG(uses);

#define CHECK_real_part\
        exp->shape = null ;\
        UNUSED_ARG(arg1);

#define CHECK_rem0                      CHECK_and

#define CHECK_rem1                      CHECK_and

#define CHECK_rem2                      CHECK_and

#define CHECK_repeat\
        exp->shape = normalize(body->shape);\
        IGNORE check1(ENC_top, start);

#define CHECK_return\
        exp->shape = sh_bottom ;\
        UNUSED_ARG(arg1);

#define CHECK_return_to_label\
        exp->shape = sh_bottom ;\
        UNUSED_ARG(lab_val);

#define CHECK_round_with_mode\
        exp->shape = sh_integer(r);\
        IGNORE check1(ENC_floating, arg1);

#define CHECK_rotate_left               CHECK_shift_left

#define CHECK_rotate_right              CHECK_shift_left

#define CHECK_sequence\
        exp->shape = normalize(result->shape);\
        UNUSED_ARG(statements);

#define CHECK_set_stack_limit\
        exp->shape = sh_top ;\
        UNUSED_ARG(lim);

#define CHECK_shape_offset\
        exp->shape = sh_offset(al_shape(s), al_top);

#define CHECK_shift_left\
        exp->shape = normalize(check1(ENC_integer, arg1));\
        IGNORE check1(ENC_integer, arg2);

#define CHECK_shift_right               CHECK_shift_left

#define CHECK_subtract_ptrs\
        node *sh1 = check1(ENC_pointer, arg1);\
        node *sh2 = check1(ENC_pointer, arg2);\
        exp->shape = sh_offset(ptr_to(sh2), ptr_to(sh1));

#define CHECK_tail_call\
        exp->shape = sh_bottom ;\
        IGNORE check1(ENC_proc, p);

#define CHECK_untidy_return\
        exp->shape = sh_bottom ;\
        UNUSED_ARG(arg1);

#define CHECK_variable\
        exp->shape = normalize(body->shape);\
        chk_tag(exp, name_intro, 1);\
        UNUSED_ARG(init);

#define CHECK_xor                       CHECK_and