Code coverage for slot_data.li
///////////////////////////////////////////////////////////////////////////////
// Lisaac Compiler //
// //
// LSIIT - ULP - CNRS - INRIA - FRANCE //
// //
// This program is free software: you can redistribute it and/or modify //
// it under the terms of the GNU General Public License as published by //
// the Free Software Foundation, either version 3 of the License, or //
// (at your option) any later version. //
// //
// This program is distributed in the hope that it will be useful, //
// but WITHOUT ANY WARRANTY; without even the implied warranty of //
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the //
// GNU General Public License for more details. //
// //
// You should have received a copy of the GNU General Public License //
// along with this program. If not, see <http://www.gnu.org/licenses/>. //
// //
// http://isaacproject.u-strasbg.fr/ //
///////////////////////////////////////////////////////////////////////////////
Section Header
+ name := SLOT_DATA;
- copyright := "2003-2007 Benoit Sonntag";
- author := "Sonntag Benoit (bsonntag@loria.fr)";
- comment := "Slot with data style";
Section Inherit
+ parent_variable:Expanded VARIABLE;
+ parent_slot:SLOT := SLOT;
Section Public
// BUG COMPILO 0.11
- id_section:SECTION_ <-
( + result:SECTION_;
(parent_slot != NULL).if {
result := parent_slot.id_section;
} else {
result := SECTION_.get_name (ALIAS_STR.section_private);
};
result
);
- receiver_type:TYPE <-
( + result:TYPE;
(parent_slot != NULL).if {
result := parent_slot.receiver_type;
} else {
result := type_block;
};
result
);
//
- common_slot:SLOT <- parent_slot;
//
// Sequence optimizer
//
+ last_write:WRITE;
+ last_seq_index:UINTEGER_32;
+ last_seq_or_and:UINTEGER_32;
+ last_seq_call_and_loop:UINTEGER_32;
+ last_seq_call_local_and_loop:UINTEGER_32;
+ last_list_current:LIST;
+ last_index:INTEGER;
- is_invariant rec:EXPR :BOOLEAN <-
(
((rec = NULL) || {rec.is_invariant})
{last_write != NULL}
{loop_seq_call_and_loop = seq_call_and_loop}
{last_seq_index <= loop_seq_index}
);
- reset_last_write w:WRITE <-
(
(last_write = w).if {
last_write := NULL;
};
);
- set_read <-
(
last_index := -1;
);
- get_last_index:INTEGER <- last_index;
- set_write w:WRITE <-
(
/* A FAIRE
(
(! PROFIL.mode_recursive)
{style = '-'}
{last_write != NULL}
{last_index < list_current.index}
{last_sequence = sequence_global}
).if {
? {list_current.item last_index = last_write};
list_current.put (last_write.value) to last_index;
unwrite last_write;
new_execute_pass;
};
*/
last_write := w;
last_seq_index := seq_index;
last_seq_or_and := seq_or_and;
last_seq_call_and_loop := seq_call_and_loop;
last_seq_call_local_and_loop:= seq_call_local_and_loop;
//
last_list_current := list_current;
last_index := list_current.index;
);
- get_last_value rec:EXPR :EXPR <-
( + result:EXPR;
+ val:EXPR;
+ rd:READ;
+ rd_loc:READ_LOCAL;
+ wrt_slot:WRITE_SLOT;
+ l:LOCAL;
+ g:SLOT_DATA;
+ is_rec_ok:BOOLEAN;
+ my_require_count:INTEGER;
+ pb:PROFIL_BLOCK;
+ i:INSTR;
((! PROFIL.mode_recursive) {loop_invariant = NULL} {last_write != NULL}).if {
my_require_count := require_count;
(rec != NULL).if {
// Block exception.
pb ?= rec.static_type.raw;
((pb != NULL) {require_list != NULL}).if {
rd_loc ?= rec;
l := rd_loc.local;
wrt_slot ?= require_first;
rd_loc ?= wrt_slot.receiver;
(rd_loc.local = l).if {
my_require_count := 1;
} else {
my_require_count := 0;
};
(require_list.lower).to (require_list.upper) do { j:INTEGER;
wrt_slot ?= require_list.item j;
rd_loc ?= wrt_slot.receiver;
(rd_loc.local = l).if {
my_require_count := my_require_count + 1;
};
};
};
};
(
(
(last_seq_call_and_loop = seq_call_and_loop)
{is_seq_list last_list_current}
) || {my_require_count = 1}
).if {
// Receiver test.
(rec = NULL).if {
is_rec_ok := TRUE;
}.elseif {rec.is_constant} then {
wrt_slot ?= last_write;
is_rec_ok := rec ~= wrt_slot.receiver;
} else {
rd ?= rec;
(rd != NULL).if {
l ?= rd.variable;
g ?= rd.variable;
wrt_slot ?= last_write;
rd ?= wrt_slot.receiver;
is_rec_ok := (rd != NULL) {
(
{l = rd.variable} {is_seq_list last_list_current} {
(
(l.last_seq != NULL) {l.last_seq.last_write != NULL}
{l.last_seq.last_seq_index < last_seq_index}
{last_seq_call_local_and_loop = seq_call_local_and_loop}
) || {l.require_count <= 1} || {l.style = ' '}
}
) ||
{
{g = rd.variable} {g.style = '-'} {
(
(g.last_write != NULL) {g.last_seq_index < last_seq_index}
{last_seq_call_and_loop = seq_call_and_loop}
{is_seq_list (g.last_list_current)}
) || {g.require_count = 1}
}
}
};
};
};
(is_rec_ok).if {
val := last_write.value;
rd ?= val;
(rd = NULL).if {
l := NULL;
g := NULL;
} else {
l ?= rd.variable;
g ?= rd.variable;
};
(
( // Constant propagation.
val.is_constant
) ||
{ // Local propagation.
(l != NULL) {is_seq_list last_list_current} {
(
(l.last_seq != NULL) {l.last_seq.last_write != NULL}
{l.last_seq.last_seq_index < last_seq_index}
{last_seq_call_local_and_loop = seq_call_local_and_loop}
) || {l.require_count <= 1} || {l.style = ' '}
}
} ||
{ // Global propagation.
(g != NULL) {g.style = '-'} {
(
(g.last_write != NULL) {g.last_seq_index < last_seq_index}
{last_seq_call_and_loop = seq_call_and_loop}
{is_seq_list (g.last_list_current)}
) || {g.require_count = 1}
}
}
).if {
(rec != NULL).if {
rec.remove;
};
result := val.my_copy;
}.elseif {
// Propagation step by step.
(last_seq_or_and = seq_or_and)
{ensure_count = 1}
{list_current.index > list_current.lower}
{list_current.item (list_current.index - 1) = last_write}
} then {
(rec != NULL).if {
rec.remove;
wrt_slot ?= last_write;
wrt_slot.receiver.remove;
};
unwrite last_write;
list_current.put NOP to (list_current.index - 1);
result := val;
}.elseif {
(rec != NULL) {is_seq_list last_list_current}
{my_require_count = 1} {ensure_count = 1}
{last_index.in_range (last_list_current.lower) to (last_list_current.upper)}
{last_list_current.item last_index = last_write}
} then {
// Local conversion.
l := type.get_temporary position;
i := l.write (last_write.position) value val;
last_list_current.put i to last_index;
result := l.read (rec.position);
//
rec.remove;
wrt_slot ?= last_write;
wrt_slot.receiver.remove;
unwrite last_write;
};
};
};
};
result
);
//
// Constructeur.
//
- create b:SLOT type_full t:TYPE_FULL :SELF <-
(
create (b.position) name (b.name) style (b.style) base b type t
);
- create pos:POSITION name n:STRING_CONSTANT
style s:CHARACTER base b:SLOT type t:TYPE_FULL :SELF <-
// BSBS: N'est plus utilise' !!!
( + result:SELF;
result := clone;
result.make pos name n style s base b type t;
result
);
- make pos:POSITION name n:STRING_CONSTANT style s:CHARACTER base b:SLOT type t:TYPE_FULL <-
( + tmp:TYPES_TMP;
parent_slot := b;
//
position := pos;
name := n;
style := s;
intern_name := ALIAS_STR.get_intern name;
//
type := t;
(is_static).if {
tmp := TYPES_TMP.new;
tmp.add (type.raw);
type_set := tmp.to_types;
} else {
type_set := TYPES_TMP.types_empty;
};
((type.raw.is_block) {name != ALIAS_STR.slot_id} {name != ALIAS_STR.slot_self}).if {
list_variable_block.add_last Self;
};
? {type != NULL};
);
//
// Context
//
+ value_init:LIST;
- init <-
( + val,rec:EXPR;
+ wrt:WRITE;
+ old_list:LIST;
+ rd:ITM_READ_ARG1;
+ old_profil_current:PROFIL;
+ old_profil_slot:PROFIL_SLOT;
/*
string_tmp.copy "init : ";
string_tmp.append name;
warning_error (position,string_tmp);
*/
((value_init = NULL) {(affect != '<') || {Self = slot_id}}).if {
// Context.
old_list := list_current;
old_profil_current := profil_current;
old_profil_slot := profil_slot;
profil_current := profil_slot := NULL;
value_init := list_current := LIST.create position;
(Self = slot_id).if {
val := PROTOTYPE_CST.create position type type;
} else {
// Code.
(value != NULL).if {
rd ?= value;
((rd != NULL) {rd.arg = NULL}).if {
rec := PROTOTYPE_CST.create position type (receiver_type.default);
val := rd.to_run_with_self (rec,FALSE,FALSE) args NULL;
} else {
val := value.to_run_expr;
};
} else {
val := type.default_value position;
};
val := val.check_type type with position;
};
(style = '+').if {
rec := PROTOTYPE_CST.create position type (receiver_type.default);
} else {
rec := NULL;
};
(debug_level_option != 0).if {
list_current.add_last (
PUSH.create position context context_main first FALSE
);
};
wrt := write position with rec value val;
(is_zero val).if {
wrt.set_quiet_generation;
};
list_current.add_last wrt;
list_current.add_last (PROTOTYPE_CST.create position type (TYPE_VOID.default)); // BSBS:Alias
list_current := old_list;
profil_current := old_profil_current;
profil_slot := old_profil_slot;
};
);
//
// Execute.
//
- execute <-
( + lst:FAST_ARRAY(SLOT);
+ slot:SLOT_DATA;
+ s:SLOT;
+ val:LIST;
+ old_list_current:LIST;
//+ old_profil_current:PROFIL_SLOT;
+ insert_index:INTEGER;
(value_init != NULL).if {
val := value_init;
value_init := NULL;
insert_index := list_main.index;
list_main.add val to insert_index;
(type.is_expanded).if {
lst := type.slot_run;
(lst != NULL).if {
(lst.lower).to (lst.upper) do { j:INTEGER;
s := lst.item j;
(s.style = '+').if {
slot := s.slot_data_intern;
(slot != NULL).if {
slot.execute;
};
slot := s.slot_id;
(slot != NULL).if {
slot.execute;
};
};
};
};
};
old_list_current := list_current;
//old_profil_current := profil_current;
list_current := NULL;
//profil_current := NULL;
val.execute;
list_main.inc_index;
list_current := old_list_current;
//profil_current := old_profil_current;
};
);
//
// Genere
//
- genere buffer:STRING <-
(
type.genere_declaration buffer;
buffer.add_last ' ';
type.genere_star_declaration buffer;
buffer.append intern_name;
buffer.append ";\n";
);
//
// Display.
//
- display buffer:STRING <-
(
buffer.append intern_name;
buffer.add_last ' ';
buffer.add_last ':';
type.display buffer;
);
- display_all <-
(
string_tmp.clear;
display string_tmp;
string_tmp.print;
);
Section VARIABLE
- new_read p:POSITION with r:EXPR :READ <-
( + result:READ;
(style = '-').if {
? {r = NULL};
result := READ_GLOBAL.create p with Self;
} else {
? {r != NULL};
result := READ_SLOT.create p with (r,Self);
};
result
);
- new_write p:POSITION with r:EXPR value v:EXPR :WRITE <-
( + result:WRITE;
(style = '-').if {
? {r = NULL};
result := WRITE_GLOBAL.create p with v in Self;
} else {
? {r != NULL};
result := WRITE_SLOT.create p with v in (r,Self);
};
result
);
/*
- new_access r:EXPR :ACCESS <-
( + result:ACCESS;
(style = '-').if {
result := ACCESS_GLOBAL.create Self;
} else {
result := ACCESS_SLOT.create Self with r;
};
result
);
*/
- is_zero e:EXPR :BOOLEAN <-
( + pro:PROTOTYPE_CST;
+ int:INTEGER_CST;
(
pro ?= e;
(pro != NULL) {
(pro.static_type.raw = TYPE_NULL) ||
{pro.static_type.raw = type_false}
}
) || {
int ?= e;
(int != NULL) {int.value = 0}
}
);