[SCM] Lisaac compiler branch, mildred-backend, updated. lisaac-0.12-441-g28d9d0c
Mildred Ki'Lya
silkensedai at online.fr
Mon Aug 24 11:10:10 UTC 2009
The following commit has been merged in the mildred-backend branch:
commit 28d9d0c75da142a9a424de1ee5f79dd9bfc1d07d
Merge: 3ee9ebfc3bcdfc4291301e7537efe8cb786e3ad6 95a0f7018bd0b04b7fd99ef3a6bfd3ae663c3aa6
Author: Mildred Ki'Lya <silkensedai at online.fr>
Date: Fri Aug 7 14:39:13 2009 +0200
merge with branch master
diff --combined src/code_life/call_slot.li
index 11a449c,8b4240d..f6c134c
--- a/src/code_life/call_slot.li
+++ b/src/code_life/call_slot.li
@@@ -184,9 -184,9 +184,9 @@@ Section Privat
+ new_src:LIST;
+ wrt:WRITE;
+ old_val:EXPR;
- + rd:READ_LOCAL;
+ //+ rd:READ_LOCAL;
+ loc:LOCAL;
- // + prof_block:PROFIL_BLOCK;
+ + prof_block:PROFIL_BLOCK;
(source = list_current).if {
POSITION.put_error semantic text "Recursivity without end (call_slot).";
@@@ -198,7 -198,7 +198,7 @@@
(
(! is_interrupt) && {! is_external} &&
{(cop_argument = NULL) || {! profil.result_list.is_empty}}
- ).if {
+ ).if {
(profil.link_count = 1).if {
//
// Inlining simple.
@@@ -219,22 -219,26 +219,26 @@@
//
(list_current.old_seq_or_and = seq_or_and).if {
profil.unlink Self;
- LOCAL.alias_on;
- /*
- "Write : ".print;
- (result_list.lower).to (result_list.upper) do { j:INTEGER;
- result_list.item j.debug_display;
- };
- "Source : ".print;
- source.debug_display;
- "--------------------\n".print;
- */
+
+ prof_block ?= profil;
+ (prof_block != NULL).if {
+ (profil.argument_list.lower).to (profil.argument_list.upper) do { j:INTEGER;
+ loc := profil.argument_list.item j;
+ (loc != NULL).if {
+ loc.set_my_alias (loc.my_copy);
+ };
+ };
+ } else {
+ LOCAL.alias_on;
+ };
+ //LOCAL.alias_on;
+
new_src := source.my_copy;
- argument_to_assignment new_src index 1 alias TRUE;
+ argument_to_assignment new_src index 1 alias TRUE;
(result_list.lower).to (result_list.upper) do { j:INTEGER;
wrt := result_list.item j.write;
old_val := wrt.value;
-
+ /*
rd ?= old_val;
loc := rd.local;
(loc.my_alias = NULL).if {
@@@ -242,18 -246,25 +246,25 @@@
warning_error (position,"CALL_SLOT : Result bizarre!");
warning_error (profil.slot.position,"CALL_SLOT : Result bizarre!");
crash_with_message "CALL_SLOT: Result not affect!";
- };
+ };*/
wrt.set_value (old_val.my_copy);
old_val.remove;
new_src.add_last wrt;
};
- LOCAL.alias_off;
- /*
- "Copy:".print;
- new_src.debug_display;
- "===========================FIN============================\n".print;
- */
+ (prof_block != NULL).if {
+ (profil.argument_list.lower).to (profil.argument_list.upper) do { j:INTEGER;
+ loc := profil.argument_list.item j;
+ (loc != NULL).if {
+ loc.set_my_alias NULL;
+ };
+ };
+ } else {
+ LOCAL.alias_off;
+ };
+
+ //LOCAL.alias_off;
+
result := new_src.execute;
is_good := TRUE;
new_execute_pass;
@@@ -417,17 -428,94 +428,17 @@@ Section Publi
//
- genere buffer:STRING <-
- ( + val:WRITE;
- + arg:LOCAL;
- + wrt:WRITE_LOCAL;
- + np:INTEGER;
- + low:INTEGER;
- + back:INTEGER;
-
+ (
(cop_argument != NULL).if {
- (
- (argument_list.count >=1) &&
- {argument_list.first != NULL} &&
- {argument_list.first.variable.name = ALIAS_STR.variable_self}
- ).if {
- low := 1;
- };
- (argument_list.count-low > 0).if {
- back := buffer.count;
- buffer.append "pthread_mutex_lock (&(";
- cop_argument.genere buffer;
- buffer.append "->thread.mutex));\n";
- (low).to (argument_list.upper) do { j:INTEGER;
- val := argument_list.item j;
- (val != NULL).if {
- buffer.append indent;
- cop_argument.genere buffer;
- buffer.append "->param_";
- np.append_in buffer;
- buffer.append "=(int)";
- val.genere_value buffer;
- buffer.append ";\n";
- np := np + 1;
- } else {
- "arg null\n".print;
- };
- };
- buffer.append indent;
- (np = 0).if {
- buffer.keep_head back;
- };
- };
- cop_argument.genere buffer;
- buffer.append "->thread.procedure = COP_";
- buffer.append (profil.name);
- buffer.append ";\n";
- buffer.append indent;
- (is_cop_return).if {
- buffer.append "return";
- } else {
- buffer.append "run_procedure";
- };
- buffer.append "((lith_object *)";
- cop_argument.genere buffer;
- buffer.add_last ')';
- } else {
- (result_list.is_empty).if_false {
- wrt ?= result_list.first.write;
- wrt.genere_first_result buffer;
- };
- buffer.append (profil.name);
- (is_interrupt || {is_external}).if {
+ backend.generate_cop_call_slot Self in buffer;
+ } else {
+ ((is_interrupt) || {is_external}).if {
(argument_list.first != NULL).if {
semantic_error (argument_list.first.position,
"Impossible `Self' argument for External or Interrupt slot.");
};
};
- (! is_interrupt).if {
- buffer.add_last '(';
- (argument_list.lower).to (argument_list.upper) do { j:INTEGER;
- val := argument_list.item j;
- arg := profil.argument_list.item j;
- (val != NULL).if {
- (buffer.last != '(').if {
- buffer.add_last ',';
- };
- val.genere_value buffer;
- };
- };
- (result_list.count > 1).if {
- (result_list.lower+1).to (result_list.upper) do { j:INTEGER;
- (buffer.last != '(').if {
- buffer.add_last ',';
- };
- wrt ?= result_list.item j.write;
- wrt.genere_argument_result buffer;
- };
- };
- buffer.add_last ')';
- };
+ backend.generate_call_slot Self in buffer;
};
);
@@@ -522,7 -610,7 +533,7 @@@ Section Privat
(is_alias).if {
loc ?= val.variable;
new_wrt := loc.write (val.position) value (val.value);
- loc.unwrite val;
+ loc.unwrite val;
} else {
new_wrt := val;
};
diff --combined src/code_life/list.li
index b84b328,a71461d..e30e89c
--- a/src/code_life/list.li
+++ b/src/code_life/list.li
@@@ -149,6 -149,15 +149,15 @@@ Section Publi
new_depend_pass;
position := p;
expr_list := FAST_ARRAY[INSTR].create_with_capacity 2;
+ /*
+ "execute list #".print;
+ object_id.print; '\n'.print;
+ (object_id = 220500).if {
+ // crash_with_message "BUG!!!";
+ };
+ */
+
+
);
- my_copy:SELF <-
@@@ -205,7 -214,7 +214,7 @@@
- execute_case <-
( + new_expr:INSTR;
+ old_list_current:LIST;
-
+
//
seq_list.add_last Self;
seq_inline := seq_inline + 1;
@@@ -253,10 -262,15 +262,10 @@@ Section Publi
//
- genere buffer:STRING <-
- (
- buffer.append "{\n";
- indent.append " ";
-
+ (
+ backend.generate_function_header_in buffer;
genere_body buffer;
-
- indent.remove_last 2;
- buffer.append indent;
- buffer.add_last '}';
+ backend.generate_function_footer_in buffer;
);
- genere_extern buffer:STRING <-
@@@ -306,12 -320,7 +315,12 @@@
Section Private
- genere_body buffer:STRING <-
- ( + old_count,j:INTEGER;
+ (
+ lower.to (upper) do { i:INTEGER;
+ backend.generate_function_instruction (item i) in buffer;
+ };
+ /*
+ + old_count,j:INTEGER;
j := lower;
{j <= upper}.while_do {
buffer.append indent;
@@@ -321,14 -330,36 +330,14 @@@
j := j + 1;
}.do_while {(j <= upper) && {old_count = buffer.count}};
buffer.append ";\n";
- };
+ };
+ */
);
- add_local tab:FAST_ARRAY[LOCAL] in buf:STRING <-
- ( + loc:LOCAL;
- + t:TYPE_FULL;
- + cur:INTEGER;
-
+ (
(! tab.is_empty).if {
- (tab.lower).to (tab.upper) do { j:INTEGER;
- loc := tab.item j;
- loc.is_result.if_false {
- (((buf.count + loc.intern_name.count - cur) > 70) || {t != loc.type}).if {
- // New line
- (t != NULL).if {
- buf.append ";\n";
- };
- cur := buf.count;
- t := loc.type;
- buf.append indent;
- t.genere_declaration buf;
- buf.add_last ' ';
- } else {
- buf.add_last ',';
- };
- t.genere_star_declaration buf;
- buf.append (loc.intern_name);
- };
- };
- buf.append ";\n";
+ backend.generate_function_locals tab in buf;
tab.clear;
};
);
diff --combined src/code_life/write.li
index 74dc53d,091473a..5f54233
--- a/src/code_life/write.li
+++ b/src/code_life/write.li
@@@ -185,7 -185,7 +185,7 @@@ Section Publi
(
variable.unwrite Self;
value.remove;
- //free_allocation_memory;
+ //free_allocation_memory;
);
//
@@@ -196,7 -196,7 +196,7 @@@
( + loc:LOCAL;
+ slo:SLOT;
- (is_local).if { // BSBS: Pour finir, il faut spécialiser les READ, WRITE avec multiheritage
+ (is_local).if { // BSBS: Pour finir, il faut sp�cialiser les READ, WRITE avec multiheritage
loc ?= variable;
add_var_size loc;
} else {
@@@ -204,13 -204,37 +204,13 @@@
slo.receiver_type.add_genere_list;
};
(quiet_generation).if_false {
- genere_access buffer;
- buffer.add_last '=';
- genere_value buffer;
+ backend.generate_write_for Self in buffer;
};
);
- genere_value buffer:STRING <-
- (
- (is_java).if {
- value.genere buffer;
- } else {
- (
- (static_type.is_expanded_ref) &&
- {! value.static_type.is_expanded_ref}
- ).if {
- ? {value.static_type.is_expanded};
- buffer.append "&(";
- value.genere buffer;
- buffer.add_last ')';
- }.elseif {
- (static_type.is_expanded) && {! static_type.is_expanded_ref} &&
- {(! value.static_type.is_expanded) || {value.static_type.is_expanded_ref}} &&
- {value.static_type.raw != TYPE_NULL} // For Pointer := NULL
- } then {
- buffer.append "*(";
- value.genere buffer;
- buffer.add_last ')';
- } else {
- value.genere buffer;
- };
- };
+ (
+ backend.generate_write_value_for Self in buffer;
);
//
diff --combined src/tools/backend.li
index 785e53d,ac0fa59..d8508f5
--- a/src/tools/backend.li
+++ b/src/tools/backend.li
@@@ -33,667 -33,6 +33,684 @@@ Section Inheri
Section Public
+ - source_extension :STRING_CONSTANT <- (deferred; NULL);
+
+ //
+ // Names
+ //
+
+ - append_type_struct_name_for t:TYPE in buf:STRING <-
+ (
+ buf.append (t.intern_name);
+ buf.append "_struct";
+ );
+
+ - append_type_name_for t:TYPE in buf:STRING <-
+ (
+ buf.append (ALIAS_STR.separate);
+ buf.append (t.intern_name);
+ );
+
+ - append_type_expanded_proto_name_for t:TYPE in buf:STRING <-
+ (
+ buf.append (t.intern_name);
+ buf.add_last '_';
+ );
+
+ - append_type_proto_name_for t:TYPE in buf:STRING <-
+ (
+ buf.append (t.intern_name);
+ buf.append (ALIAS_STR.separate);
+ );
+
+ - append_type_typeid_name_for t:TYPE in buf:STRING <-
+ (
+ buf.append (ALIAS_STR.separate);
+ buf.append (t.intern_name);
+ buf.append (ALIAS_STR.separate);
+ );
+
+ //
+ // Type
+ //
+
+ - generate_type_typedef_for t:TYPE in buf:STRING <- deferred;
+ - generate_type_struct_for t:TYPE in buf:STRING <- deferred;
+ - generate_type_globals_for t:TYPE in buf:STRING <- deferred;
+
+ - generate_type_struct_for_generic_in buf:STRING <- deferred;
+ - generate_type_struct_for_null_in buf:STRING <- deferred;
+ - generate_type_struct_for_context_in buf:STRING <- deferred;
+
+ - generate_type_reference_star_declaration_in buf:STRING <- deferred;
+ - generate_type_expanded_declaration_for t:TYPE in buf:STRING <- deferred;
+ - generate_type_generic_declaration_in buf:STRING <- deferred;
+ - generate_type_access_id_for_expr e:EXPR in buf:STRING <- deferred;
+ - generate_type_access_id_for_block e:EXPR in buf:STRING <-
+ (
+ e.genere buf;
+ //buf.append ".__id";
+ );
+
+ //
+ // Functions
+ //
+
+ - generate_function_header_in buffer:STRING <-
+ (
+ buffer.append "{\n";
+ indent.append " ";
+ );
+
+ - generate_function_locals tab:FAST_ARRAY[LOCAL] in buf:STRING <-
+ [
+ -? { ! tab.is_empty };
+ ]
+ ( + loc:LOCAL;
+ + t:TYPE_FULL;
+ + cur:INTEGER;
+
+ (tab.lower).to (tab.upper) do { j:INTEGER;
+ loc := tab.item j;
+ loc.is_result.if_false {
+ (((buf.count + loc.intern_name.count - cur) > 70) || {t != loc.type}).if {
+ // New line
+ (t != NULL).if {
+ buf.append ";\n";
+ };
+ cur := buf.count;
+ t := loc.type;
+ buf.append indent;
+ t.genere_declaration buf;
+ buf.add_last ' ';
+ } else {
+ buf.add_last ',';
+ };
+ t.genere_star_declaration buf;
+ buf.append (loc.intern_name);
+ };
+ };
+ buf.append ";\n";
+ );
+
+ - generate_function_instruction i:INSTR in buffer:STRING <-
+ ( + count:INTEGER;
+ buffer.append indent;
+ count := buffer.count;
+ i.genere buffer;
+ (buffer.count = count).if {
+ buffer.remove_last (indent.count);
+ } else {
+ buffer.append ";\n";
+ };
+ );
+
+ - generate_function_footer_in buffer:STRING <-
+ (
+ indent.remove_last 2;
+ buffer.append indent;
+ buffer.add_last '}';
+ );
+
+ //
+ // Read and Write
+ //
+
+ - generate_read_slot_for read: READ_SLOT in buf:STRING <- deferred;
+ - generate_write_slot_for write:WRITE_SLOT in buf:STRING <- deferred;
+ - generate_write_for write:WRITE in buf:STRING <-
+ (
+ write.genere_access buf;
+ buf.add_last '=';
+ write.genere_value buf;
+ );
+ - generate_write_value_for write:WRITE in buf:STRING <-
+ (
+ write.value.genere buf;
+ );
+
+ //
+ // Other instructions
+ //
+
+ - generate_instruction_deferred i:INSTR in buf:STRING <-
+ (
+ buf.append "#error \"";
+ buf.append "INSTR: can't generate instruction: ";
+ i.display buf;
+ buf.add_last '"';
+ );
+
+ - generate_call_on_null_in buffer:STRING <-
+ (
+ (debug_level_option != 0).if {
+ buffer.append
+ "stack_print(top_context); \
+ \print_string(\"Call on NULL\\n\"); \
+ \die_with_code(1)";
+ } else {
+ buffer.append
+ "print_string(\"Call on NULL\\n\
- \(Use `-D' option)\\n\"); \
++ \(Use `debug' option)\\n\"); \
+ \die_with_code(1)";
+ };
+ );
+
+ - generate_put_to put_to:PUT_TO for_type t:TYPE_FULL in buffer:STRING <-
+ (
+ put_to.receiver.genere buffer;
+ buffer.add_last '[';
+ put_to.index.genere buffer;
+ buffer.append "]=";
+
+ ((t.is_expanded) && {! t.is_expanded_c} &&
+ {put_to.value.static_type.is_expanded_ref}).if
+ {
+ buffer.append "*(";
+ put_to.value.genere buffer;
+ buffer.add_last ')';
+ } else {
+ put_to.value.genere buffer;
+ };
+ );
+
+ - generate_loop_while_do l:LOOP
+ condition e:EXPR
+ inverse inverse:BOOLEAN
+ body lst:LIST
+ in buffer:STRING <-
+ (
+ buffer.append "while (";
+ inverse.if { buffer.add_last '!'; };
+ e.genere buffer;
+ buffer.append ") ";
+ lst.genere buffer;
+ );
+
+ - generate_loop_do_while l:LOOP
+ condition e:EXPR
+ inverse inverse:BOOLEAN
+ body lst:LIST
+ in buffer:STRING <-
+ (
+ buffer.append "do ";
+ lst.genere buffer;
+ buffer.append " while (";
+ inverse.if { buffer.add_last '!'; };
+ e.genere buffer;
+ buffer.add_last ')';
+ );
+
+ - generate_loop l:LOOP in buffer:STRING <-
+ (
+ buffer.append (l.name);
+ buffer.append ":\n";
+ buffer.append indent;
+ l.body.genere buffer;
+ );
+
+ - generate_loop_end l:LOOP_END in buffer:STRING <-
+ (
+ buffer.append "goto ";
+ buffer.append (l.loop.name);
+ );
+
+ - generate_if sw:SWITCH in buffer:STRING :INTEGER <-
+ ( + first_case:INTEGER;
+ + typ_first:TYPE;
+ + typ_id:TYPE_ID;
+ typ_first := sw.list.first.id;
+ typ_id ?= typ_first;
+
+ //
+ // If Condition
+ //
+ buffer.append "if (";
+ ((sw.expr.static_type.raw.is_block) && {typ_first = TYPE_NULL}).if {
+ sw.expr.genere buffer;
+ buffer.append ".__id==0";
+ } else {
+ typ_first.put_access_id (sw.expr) in buffer;
+ (sw.expr.static_type.raw != type_boolean).if {
+ buffer.append "==";
+ typ_first.put_id buffer;
+ } else {
+ ? {typ_first.shortname = ALIAS_STR.prototype_true};
+ };
+ };
+ buffer.append ") ";
+
+ //
+ // If Block
+ //
+ sw.list.first.genere buffer;
+ first_case := 1;
+
+ //
+ // Else
+ //
+ (sw.list.count = 2).if {
+ buffer.append " else ";
+ buffer.append "/* ";
+ buffer.append (sw.list.second.id.name);
+ buffer.append " */ ";
+ sw.list.second.genere buffer;
+ first_case := 2;
+ };
+
+ first_case
+ );
+
+ - generate_if_else_begin sw:SWITCH in buffer:STRING <-
+ (
+ buffer.append " else {\n";
+ indent.append " ";
+ buffer.append indent;
+ );
+
+ - generate_if_else_end sw:SWITCH in buffer:STRING <-
+ (
+ buffer.add_last '\n';
+ indent.remove_last 2;
+ buffer.append indent;
+ buffer.add_last '}';
+ );
+
+ - generate_switch sw:SWITCH first_case first_case:INTEGER in buffer:STRING <-
+ (
+ //
+ // Switch
+ //
+ buffer.append "switch (";
+ sw.list.item first_case.id.put_access_id (sw.expr) in buffer;
+ buffer.append ") {\n";
+
+ //
+ // Each case
+ //
+ (first_case).to (sw.list.upper) do { j:INTEGER;
+ buffer.append indent;
+ buffer.append "case ";
+ sw.list.item j.id.put_id buffer;
+ buffer.append ": ";
+ sw.list.item j.genere buffer;
+ buffer.add_last ' ';
+ buffer.append "break;\n";
+ };
+
++ //
++ // Twilight Zone (default)
++ //
++ buffer.append indent;
++ buffer.append "default: ";
++ (debug_level_option != 0).if {
++ buffer.append
++ "stack_print(top_context); \
++ \print_string(\"Call on Twilight Zone\\n\"); \
++ \die_with_code(1);";
++ } else {
++ buffer.append
++ "print_string(\"Call on Twilight Zone\\n\
++ \(Use `debug' option)\\n\"); \
++ \die_with_code(1);";
++ };
++
+ buffer.append indent;
+ buffer.add_last '}';
+ );
+
+
+ - generate_cop_lock l:COP_LOCK in buffer:STRING <-
+ (
+ buffer.append "// Pre thread.\n";
+ // buffer.append "print_char('(');\n";
+ // buffer.append "print_char('\\n');\n";
+ buffer.append indent;
+ buffer.append "{ lith_node node,*n;\n";
+ indent.append " ";
+ buffer.append indent;
+ buffer.append "lith_object *obj;\n";
+ buffer.append indent;
+ buffer.append "void *thread_save;\n";
+ buffer.append indent;
+ buffer.append "obj = &((";
+ l.data.genere buffer;
+ buffer.append ")->thread);\n";
+ buffer.append indent;
+ buffer.append "node.next = NULL;\n";
+ buffer.append indent;
+ buffer.append "pthread_mutex_init(&node.mutex,NULL);\n";
+ buffer.append indent;
+ buffer.append "pthread_mutex_lock(&obj->mutex);\n";
+ buffer.append indent;
+ buffer.append "n = obj->last;\n";
+ buffer.append indent;
+ buffer.append "if (n == NULL) {\n";
+ buffer.append indent;
+ buffer.append " obj->first = &node;\n";
+ buffer.append indent;
+ buffer.append "} else {\n";
+ buffer.append indent;
+ buffer.append " n->next = &node;\n";
+ buffer.append indent;
+ buffer.append " pthread_mutex_lock(&node.mutex);\n";
+ buffer.append indent;
+ buffer.append "};\n";
+ buffer.append indent;
+ buffer.append "obj->last = &node;\n";
+ buffer.append indent;
+ buffer.append "pthread_mutex_unlock(&obj->mutex);\n";
+ //
+ buffer.append indent;
+ buffer.append "pthread_mutex_lock (&node.mutex);\n";
+ buffer.append indent;
+ buffer.append "thread_save=pthread_getspecific(current_thread);\n";
+ buffer.append indent;
+ buffer.append "pthread_setspecific(current_thread,";
+ l.data.genere buffer;
+ buffer.add_last ')';
+ );
+
+ - generate_cop_unlock l:COP_UNLOCK in buffer:STRING <-
+ (
+ buffer.append "pthread_mutex_lock(&(obj->mutex));\n";
+ buffer.append indent;
+ buffer.append "n = obj->first->next;\n";
+ buffer.append indent;
+ buffer.append "if (n != NULL) {\n";
+ buffer.append indent;
+ buffer.append " pthread_mutex_unlock(&n->mutex);\n";
+ buffer.append indent;
+ buffer.append "} else {\n";
+ buffer.append indent;
+ buffer.append " obj->last = NULL;\n";
+ buffer.append indent;
+ buffer.append "};\n";
+ buffer.append indent;
+ buffer.append "obj->first = n;\n";
+ buffer.append indent;
+ buffer.append "pthread_mutex_unlock(&obj->mutex);\n";
+ buffer.append indent;
+ buffer.append "pthread_setspecific(current_thread,thread_save);\n";
+ indent.remove_last 2;
+ buffer.append indent;
+ buffer.add_last '}';
+ );
+
+ - generate_cop_call_slot call:CALL_SLOT in buffer:STRING <-
+ ( + val:WRITE;
+ + np:INTEGER;
+ + low:INTEGER;
+ + back:INTEGER;
+
+ (
+ (call.argument_list.count >=1) &&
+ {call.argument_list.first != NULL} &&
+ {call.argument_list.first.variable.name = ALIAS_STR.variable_self}
+ ).if {
+ low := 1;
+ };
+ (call.argument_list.count-low > 0).if {
+ back := buffer.count;
+ buffer.append "pthread_mutex_lock (&(";
+ call.cop_argument.genere buffer;
+ buffer.append "->thread.mutex));\n";
+ (low).to (call.argument_list.upper) do { j:INTEGER;
+ val := call.argument_list.item j;
+ (val != NULL).if {
+ buffer.append indent;
+ call.cop_argument.genere buffer;
+ buffer.append "->param_";
+ np.append_in buffer;
+ buffer.append "=(int)";
+ val.genere_value buffer;
+ buffer.append ";\n";
+ np := np + 1;
+ } else {
+ "arg null\n".print;
+ };
+ };
+ buffer.append indent;
+ (np = 0).if {
+ buffer.keep_head back;
+ };
+ };
+ call.cop_argument.genere buffer;
+ buffer.append "->thread.procedure = COP_";
+ buffer.append (call.profil.name);
+ buffer.append ";\n";
+ buffer.append indent;
+ (call.is_cop_return).if {
+ buffer.append "return";
+ } else {
+ buffer.append "run_procedure";
+ };
+ buffer.append "((lith_object *)";
+ call.cop_argument.genere buffer;
+ buffer.add_last ')';
+ );
+
+ - generate_call_slot call:CALL_SLOT in buffer:STRING <-
+ ( + val:WRITE;
+ + arg:LOCAL;
+ + wrt:WRITE_LOCAL;
+
+ //
+ // Get the return value
+ //
+ (call.result_list.is_empty).if_false {
+ wrt ?= call.result_list.first.write;
+ wrt.genere_first_result buffer;
+ };
+
+ //
+ // Function Call
+ //
+ buffer.append (call.profil.name);
+ (! call.is_interrupt).if {
+ buffer.add_last '(';
+
+ //
+ // Argument List
+ //
+ (call.argument_list.lower).to (call.argument_list.upper) do { j:INTEGER;
+ val := call.argument_list.item j;
+ arg := call.profil.argument_list.item j;
+ (val != NULL).if {
+ (buffer.last != '(').if {
+ buffer.add_last ',';
+ };
+ val.genere_value buffer;
+ };
+ };
+
+ //
+ // Result List
+ //
+ (call.result_list.count > 1).if {
+ (call.result_list.lower+1).to (call.result_list.upper) do { j:INTEGER;
+ (buffer.last != '(').if {
+ buffer.add_last ',';
+ };
+ wrt ?= call.result_list.item j.write;
+ wrt.genere_argument_result buffer;
+ };
+ };
+
+ //
+ // End
+ //
+ buffer.add_last ')';
+ };
+ );
+
+ - generate_push p:PUSH id id:UINTEGER_32 in buffer:STRING <-
+ (
+ p.is_first.if {
+ buffer.append "push_first(&";
+ } else {
+ buffer.append "push(&";
+ };
+ buffer.append (p.context.intern_name);
+ buffer.add_last ',';
+ (debug_with_code).if {
+ buffer.add_last 'L';
+ };
+ id.append_in buffer;
+ buffer.add_last ')';
+ buffer.append "; // L";
+ p.position.line.append_in buffer;
+ buffer.add_last ' ';
+ buffer.append (p.position.prototype.name);
+ );
+
+ //
+ // Misc Code
+ //
+
+ - append_null_value_in buf:STRING <- deferred;
+ - append_cop_init_code_in buf:STRING <- deferred;
+ - append_init_code_in buf:STRING input_name input_name:STRING_CONSTANT <- deferred;
+ - append_debug_code_in buf:STRING <- deferred;
+ - append_main_function_in buf:STRING <- deferred;
+ - append_main_init_code_in buf:STRING <- deferred;
+ - append_main_return_code_in buf:STRING <- deferred;
+ - append_end_of_file_in buf:STRING;
+
+ - generate_table_type_in buf:STRING <- deferred;
+ - generate_debug_manager_in buf:STRING <- deferred;
+ - generate_trace_declarations_in buf:STRING <- deferred;
+ - generate_trace_codedata_in buf:STRING declarations_in decl:STRING <- deferred;
+ - generate_trace_code_in buf:STRING <- deferred;
+
+ - generate_title txt:STRING_CONSTANT in buf:STRING <-
+ (
+ buf.append "\n//";
+ 3.to 28 do { j:INTEGER;
+ buf.add_last '=';
+ };
+ buf.append "//\n// ";
+ buf.append txt;
+ (txt.count+5).to 28 do { j:INTEGER;
+ buf.add_last ' ';
+ };
+ buf.append " //\n//";
+ 3.to 28 do { j:INTEGER;
+ buf.add_last '=';
+ };
+ buf.append "//\n\n";
+ );
+
+
+Section STRING_CST
+
+ //
+ // STRING_CONSTANT
+ //
+
+ - string_constant_declaration :STRING :=
+ ( + result:STRING;
+
+ result := STRING.create 256;
+ title "STRING CONSTANT" in result;
+ result
+ );
+
+ - string_constant_count :INTEGER;
+
+Section Public
+
+ - generate_string_constant s:STRING_CST in buffer:STRING <-
+ ( + idx,count,cur:INTEGER;
+ + output :STRING;
+ - is_init:BOOLEAN;
+ - is_storage:BOOLEAN;
+ - is_count:BOOLEAN;
+
+ output := string_constant_declaration;
+ // use a shorter name
+
+ (is_init).if_false {
+ is_storage := type_string_constant.get_local_slot (ALIAS_STR.slot_storage)
+ .slot_data_intern
+ .ensure_count != 0;
+ is_count := type_string_constant.get_local_slot (ALIAS_STR.slot_count)
+ .slot_data_intern
+ .ensure_count != 0;
+ is_init := TRUE;
+ };
+
+ count := s.dico_string.fast_at (s.string);
+ (count >= 0).if {
+ string_constant_count := string_constant_count + 1;
+ idx := string_constant_count;
+
+ cur := output.count - 1;
+ (is_java).if {
+ output.append "private static ";
+ };
+ append_type_name_for type_string_constant in output;
+ ((output.count - cur) >= 78).if {
+ output.add_last '\n';
+ cur := output.count - 1;
+ } else {
+ output.add_last ' ';
+ };
+ output.append "__string_";
+ idx.append_in output;
+ output.add_last '=';
+ (is_java).if {
+ output.append "new ";
+ append_type_name_for type_string_constant in output;
+ output.add_last '(';
+ } else {
+ output.add_last '{';
+ (s.static_type.is_late_binding).if {
+ append_type_typeid_name_for (s.static_type.raw) in output;
+ };
+ };
+ (is_count).if {
+ count.append_in output;
+ output.add_last ',';
+ };
+ (is_storage).if {
+ ((output.count - cur) >= 78).if {
+ output.add_last '\n';
+ cur := output.count - 1;
+ };
+ output.add_last '\"';
+ append_escaped_string (s.string)
+ in output
+ split_every 78
+ starting (output.count - cur);
+ output.add_last '\"';
+ } else {
+ output.remove_last 1;
+ };
+ (is_java).if {
+ output.append ");\n";
+ } else {
+ output.append "};\n";
+ };
+ s.dico_string.fast_put (-idx) to (s.string);
+ } else {
+ idx := -count;
+ };
+ //
+ (is_java).if {
+ buffer.append "__string_";
+ idx.append_in buffer;
+ } else {
+ buffer.append "(&__string_";
+ idx.append_in buffer;
+ buffer.add_last ')';
+ };
+ );
+
+ //
+ // String Constant
+ //
+
- append_string str:ABSTRACT_STRING in buf:STRING <-
(
buf.add_last '\"';
@@@ -708,6 -47,10 +725,6 @@@
buf.add_last '\'';
);
-
-
-
-
- append_escaped_character c:CHARACTER in buf:STRING <-
(
(c = '\0').if { buf.add_last '\\'; buf.add_last '0';
diff --combined src/tools/backend_c.li
index 9735541,bab552a..7f13a9f
--- a/src/tools/backend_c.li
+++ b/src/tools/backend_c.li
@@@ -33,666 -33,4 +33,667 @@@ Section Inheri
Section Public
+ - source_extension :STRING_CONSTANT := ALIAS_STR.ext_c;
+
+ - generate_type_typedef_for t:TYPE in buf:STRING <-
+ (
+ buf.append "typedef ";
+ (t.type_c != NULL).if {
+ buf.append (t.type_c);
+ } else {
+ buf.append "struct ";
+ append_type_struct_name_for t in buf;
+ };
+ append_type_name_for t in buf;
+ buf.append ";\n";
+ );
+
+ - generate_type_struct_for_generic_in buf:STRING <-
+ (
+ buf.append
+ "// Generic Object\n\
+ \struct ___OBJ {\n\
+ \ unsigned long __id;\n\
+ \};\n\n";
+ );
+
+ - generate_type_struct_for_null_in buf:STRING <-
+ (
+ buf.append
+ "// NULL\n\
+ \#ifndef NULL\n\
+ \#define NULL ((void *)0)\n\
+ \#endif\n\n";
+ );
+
+ - generate_type_struct_for_context_in buf:STRING <-
+ (
+ buf.append
+ "// ___CONTEXT\n\
+ \typedef struct ___CONTEXT_struct _____CONTEXT; \n\
+ \struct ___CONTEXT_struct {\n\
+ \ unsigned long code; \n\
+ \ _____CONTEXT *back; \n\
+ \};\n\
+ \_____CONTEXT *top_context; \n\n";
+ );
+
+ - generate_type_struct_for t:TYPE in buf:STRING <-
+ ( + slot_data:SLOT_DATA;
+ + tab:FAST_ARRAY[SLOT_DATA];
+ + num_slots :INTEGER;
+
+
+ //
+ // Type C
+ //
+
+ (t.type_c != NULL).if {
+ // Define TRUE__ and FALSE__ constants
+ ((t.shortname = ALIAS_STR.prototype_true) ||
+ {t.shortname = ALIAS_STR.prototype_false}).if
+ {
+ buf.append "#define ";
+ append_type_proto_name_for t in buf;
+ buf.append " ";
+ buf.add_last ((t.shortname = ALIAS_STR.prototype_true).to_character);
+ buf.add_last '\n';
+ };
+
+
+ //
+ // Lisaac defined type
+ //
+
+ } else {
+
+ //
+ // Comment
+ //
+ buf.append "// ";
+ buf.append (t.intern_name);
+ buf.add_last '\n';
+
+ //
+ // Type ID
+ //
+ buf.append "#define ";
+ append_type_typeid_name_for t in buf;
+ buf.append " ";
+ t.is_late_binding.if {
+ TYPE.generate_id_with_type.append_in buf;
+ } else {
+ TYPE.generate_id_without_type.append_in buf;
+ };
+ buf.add_last '\n';
+
+ //
+ // Start the struct declaration
+ //
+ buf.append "struct ";
+ append_type_struct_name_for t in buf;
+ buf.append " {\n";
+
+ //
+ // Generate extra slots before data slots
+ // - for COP
+ // - type_id for late binding
+ //
+ (t.prototype.style = '-').if {
+ buf.append " lith_object thread;\n";
+ (t.param_count != 0).if {
+ 1.to (t.param_count) do { n:INTEGER;
+ buf.append " int param_";
+ (n-1).append_in buf;
+ buf.append ";\n";
+ num_slots := num_slots + 1;
+ };
+ };
+ }.elseif {t.is_late_binding} then {
+ string_tmp.append " unsigned long __id;\n";
+ num_slots := num_slots + 1;
+ };
+
+ //
+ // Generate data slots ordered by size
+ //
+ ? { t.slot_size.upper = 4 };
+ ? { t.slot_size.lower = 0 };
+ (t.slot_size.upper).downto (t.slot_size.lower) do { j:INTEGER;
+ tab := t.slot_size.item j;
+ (tab.lower).to (tab.upper) do { i:INTEGER;
+ slot_data := tab.item i;
+ ((t.prototype.is_mapping) && {slot_data.type.is_expanded_c}).if {
+ buf.append " volatile ";
+ } else {
+ buf.append " ";
+ };
+ slot_data.genere buf;
+ num_slots := num_slots + 1;
+ };
+ tab.clear;
+ };
+
+ //
+ // Generate extra slots after data slots
+ // - for BLOCK
+ // - dummy slot if no slots were generated
+ //
+ (t = type_block).if {
+ buf.append " void *self;\n";
+ num_slots := num_slots + 1;
+ };
+ (num_slots == 0).if {
+ buf.append " void *Nothing;\n";
+ };
+
+ //
+ // End structure declaration
+ //
+ (t.prototype.is_mapping).if {
+ buf.append "} __attribute__ ((packed));\n";
+ } else {
+ buf.append "};\n";
+ };
+ };
+ );
+
+
+ - generate_type_globals_for t:TYPE in buf:STRING <-
+ (
+ (t.type_c = NULL).if {
+ append_type_name_for t in buf;
+ buf.add_last ' ';
+ append_type_expanded_proto_name_for t in buf;
+ t.is_late_binding.if {
+ buf.append "={";
+ append_type_typeid_name_for t in buf;
+ buf.append (t.intern_name);
+ buf.append "}";
+ };
+ buf.append ";\n";
+ buf.append "#define ";
+ append_type_proto_name_for t in buf;
+ buf.append " (&";
+ append_type_expanded_proto_name_for t in buf;
+ buf.append ")\n\n";
+ };
+
+ );
+
+ - generate_type_reference_star_declaration_in buf:STRING <-
+ (
+ buf.add_last '*';
+ );
+
+ - generate_type_expanded_declaration_for t:TYPE in buf:STRING <-
+ (
+ append_type_name_for t in buf;
+ );
+
+ - generate_type_generic_declaration_in buf:STRING <-
+ (
+ buf.append (ALIAS_STR.c_void);
+ );
+
+
+ - generate_type_access_id_for_expr e:EXPR in buf:STRING <-
+ (
+ buf.append "((struct ___OBJ *)";
+ e.genere buf;
+ buf.append ")->__id";
+ );
+
+ - generate_read_slot_for read:READ_SLOT in buf:STRING <-
+ ( + tf:TYPE_FULL;
+ + t:TYPE;
+
+ (read.slot.intern_name = ALIAS_STR.slot_self).if {
+ // TODO: Mildred: WHAT IS THAT?
+ // If it's for BLOCKs only, why not test the type ?
+ buf.append "((";
+ tf := read.slot.type;
+ tf.genere_declaration buf;
+ buf.add_last ' ';
+ tf.genere_star_declaration buf;
+ buf.add_last ')';
+ read.receiver.genere buf;
+ buf.append ".self)";
+ } else {
+ tf := read.receiver.static_type;
+ ((tf.is_strict) || {tf.is_expanded_ref}).if {
+ read.receiver.genere buf;
+ buf.append "->";
+ }.elseif {tf.is_expanded} then {
+ read.receiver.genere buf;
+ buf.add_last '.';
+ } else {
+ buf.append "((";
+ t := read.slot.receiver_type;
+ t.put_reference_declaration buf;
+ buf.add_last ' ';
+ t.put_reference_star_declaration buf;
+ buf.add_last ')';
+ read.receiver.genere buf;
+ buf.append ")->";
+ };
+ buf.append (read.variable.intern_name);
+ };
+ );
+
+ - generate_write_slot_for write:WRITE_SLOT in buf:STRING <-
+ ( + tf:TYPE_FULL;
+ + t:TYPE;
+
+ // Receiver.
+ tf := write.receiver.static_type;
+ ((tf.is_strict) || {tf.is_expanded_ref}).if {
+ write.receiver.genere buf;
+ buf.append "->";
+ }.elseif {tf.is_expanded} then {
+ write.receiver.genere buf;
+ buf.add_last '.';
+ } else {
+ buf.append "((";
+ t := write.slot.receiver_type;
+ t.put_reference_declaration buf;
+ buf.add_last ' ';
+ t.put_reference_star_declaration buf;
+ buf.add_last ')';
+ write.receiver.genere buf;
+ buf.append ")->";
+ };
+ //
+ buf.append (write.variable.intern_name);
+ //
+ ((write.value.static_type.raw = TYPE_NULL) &&
+ {write.variable.type.raw.is_block}).if
+ {
+ buf.append ".__id=0";
+ } else {
+ buf.add_last '=';
+ write.genere_value buf;
+ };
+ );
+
+ - generate_write_value_for write:WRITE in buf:STRING <-
+ (
+ (
+ (write.static_type.is_expanded_ref) &&
+ {! write.value.static_type.is_expanded_ref}
+ ).if {
+ ? {write.value.static_type.is_expanded};
+ buf.append "&(";
+ write.value.genere buf;
+ buf.add_last ')';
+ }.elseif {
+ ( write.static_type.is_expanded ) &&
+ {! write.static_type.is_expanded_ref } &&
+ { (! write.value.static_type.is_expanded) ||
+ { write.value.static_type.is_expanded_ref} } &&
+ { write.value.static_type.raw != TYPE_NULL } // For Pointer := NULL
+ } then {
+ buf.append "*(";
+ write.value.genere buf;
+ buf.add_last ')';
+ } else {
+ write.value.genere buf;
+ };
+ );
+
+
+ - append_null_value_in buf:STRING <-
+ (
+ buf.append "NULL";
+ );
+
+
+ - append_cop_init_code_in buf:STRING <-
+ (
+ buf.append
+ "#include <pthread.h>\n\
+ \#include <limits.h>\n\n\
+ \void print_char(char car);\n\
+ \int die_with_code(int code);\n\n\
+ \static pthread_key_t current_thread;\n\
+ \static pthread_attr_t thread_attr;\n\
+ \pthread_t c_thread;\n\
+ \int thread_counter;\n\n\
+ \static char thread_stack[512][PTHREAD_STACK_MIN];\n\n\
+ \typedef struct lith_object_struct lith_object;\n\
+ \typedef struct lith_node_struct lith_node;\n\
+ \struct lith_node_struct {\n\
+ \ pthread_mutex_t mutex;\n\
+ \ lith_node *next;\n\
+ \ lith_object *object;\n\
+ \};\n\
+ \struct lith_object_struct {\n\
+ \ unsigned long __id; // Just for late binding.\n\
+ \ lith_node *first;\n\
+ \ lith_node *last;\n\
+ \ lith_object *(*procedure)(lith_object *obj,pthread_mutex_t *mutex);\n\
+ \ pthread_mutex_t mutex;\n\
+ \};\n\
+ \struct {\n\
+ \ lith_node *first;\n\
+ \ pthread_mutex_t mutex;\n\
+ \} pool;\n\n\
+ \void *thread_life(void *ptr)\n\
+ \{ lith_node node,*n;\n\
+ \ lith_object *obj,*new_obj;\n\n\
+ \ pthread_mutex_init(&node.mutex,NULL);\n\
+ \ pthread_mutex_lock(&node.mutex);\n\
+ \ node.object = (lith_object *)ptr;\n\
+ \ do {\n\
+ \ // Append fifo object.\n\
+ \ obj = node.object;\n\
+ \ node.next = NULL;\n\
+ \ n = obj->last;\n\
+ \ if (n == NULL) {\n\
+ \ obj->first = &node;\n\
+ \ pthread_mutex_unlock(&node.mutex);\n\
+ \ } else {\n\
+ \ n->next = &node;\n\
+ \ };\n\
+ \ obj->last = &node;\n\
+ \ pthread_setspecific(current_thread,(void *)obj);\n\
+ \ // Run procedure.\n\
+ \ new_obj = obj->procedure(obj,&node.mutex);\n\
+ \ // Remove fifo object.\n\
+ \ pthread_mutex_lock(&obj->mutex);\n\
+ \ n = obj->first->next;\n\
+ \ if (n != NULL) {\n\
+ \ pthread_mutex_unlock(&n->mutex);\n\
+ \ } else {\n\
+ \ obj->last = NULL;\n\
+ \ };\n\
+ \ obj->first = n;\n\
+ \ pthread_mutex_unlock(&obj->mutex);\n\
+ \ if (new_obj != NULL) {\n\
+ \ node.object = new_obj;\n\
+ \ } else {\n\
+ \ // Add in pool.\n\
+ \ pthread_mutex_lock(&pool.mutex);\n\
+ \ node.next = pool.first;\n\
+ \ pool.first = &node;\n\
+ \ pthread_mutex_unlock(&pool.mutex);\n\
+ \ // Sleep.\n\
+ \ pthread_mutex_lock(&node.mutex);\n\
+ \ };\n\
+ \ } while (1);\n\
+ \ return NULL;\n\
+ \};\n\n\
+ \void run_procedure(lith_object *obj)\n\
+ \{ lith_node *node;\n\
+ \ char *msg=\"COP Error!\\n\";\n\
+ \ // Pool manager.\n\
+ \ pthread_mutex_lock(&pool.mutex);\n\
+ \ node = pool.first;\n\
+ \ if (node != NULL) {\n\
+ \ pool.first = node->next;\n\
+ \ };\n\
+ \ pthread_mutex_unlock(&pool.mutex);\n\
+ \ // Run thread.\n\
+ \ if (node == NULL) {\n\
+ \ pthread_attr_setstack(&thread_attr, thread_stack[thread_counter++],PTHREAD_STACK_MIN);\n\
+ \ if ((thread_counter>512) || pthread_create(&c_thread,&thread_attr, thread_life, (void *)obj)) {\n\
+ \ while (*msg != 0) print_char(*(msg++));\n\
+ \ die_with_code(1);\n\
+ \ };\n\
+ \ } else {\n\
+ \ node->object = obj;\n\
+ \ pthread_mutex_unlock(&node->mutex);\n\
+ \ };\n\
+ \};\n\n";
+ );
+
+ - append_init_code_in buf:STRING input_name input_name:STRING_CONSTANT <-
+ (
+ buf.append "// C code generated by Lisaac compiler (www.isaacOS.com) //\n";
+ // ANSI argument command.
+ (debug_level_option != 0).if {
+ buf.append "#include <signal.h>\n";
+ };
+ buf.append
+ "int arg_count;\n\
+ \char **arg_vector;\n";
+ );
+
+ - append_debug_code_in buf:STRING <-
+ (
- ((debug_level_option != 0) || {CALL_NULL.is_necessary}).if {
- buf.append "// Debug Manager\n";
- buf.append "void print_string(char *str);\n";
- };
+ (debug_level_option != 0).if {
++ buf.append "// Debug Manager\n";
+ (is_ansi).if {
+ buf.append "void interrupt_signal(int sig);\n";
+ };
+ buf.append
+ "void stack_print(_____CONTEXT *up);\n\
+ \void push_first(_____CONTEXT *path,unsigned long code);\n\
+ \void push(_____CONTEXT *path,unsigned long code);\n\
+ \void print_integer(unsigned short n);\n";
+ };
+ );
+
+ - append_main_function_in buf:STRING <-
+ (
+ buf.append "int main(int argc,char **argv)\n";
+ buf.append "{\n";
+ );
+
+ - append_main_init_code_in buf:STRING <-
+ (
+ (debug_level_option != 0).if {
+ buf.append "signal(SIGINT,interrupt_signal);\n ";
+ };
+ buf.append
+ "arg_count = argc;\n\
+ \ arg_vector = argv;\n\
+ \#ifdef _PTHREAD_H\n\
+ \ pthread_key_create(¤t_thread, NULL);\n\
+ \ pthread_attr_init(&thread_attr);\n\
+ \ /*pthread_attr_setdetachstate(&thread_attr,PTHREAD_CREATE_DETACHED);*/\n\
+ \#endif\n ";
+ );
+
+ - append_main_return_code_in buf:STRING <-
+ (
+ buf.append " return 0;\n";
+ indent.remove_last 2;
+ buf.append indent;
+ buf.append "}\n\n";
+ );
+
+ - generate_table_type_in buf:STRING <-
+ (
+ buf.append "\nvoid *table_type[";
+ TYPE.id_counter_without_type.append_in buf;
+ buf.append "];\n";
+ );
+
+ - generate_debug_manager_in buf:STRING <-
+ (
+ buf.append
- "void print_string(char *str) \n\
++ "int print_string(char *str) \n\
+ \{ \n\
+ \ while (*str!=0) {\n\
+ \ print_char(*str); \n\
+ \ str++; \n\
+ \ };\n\
+ \}\n\
+ \\n";
+ );
+
+ - generate_trace_declarations_in buf:STRING <-
+ ( + proto:PROTOTYPE;
+
+ buf.append "char *trace[";
+ buf.append (PROTOTYPE.prototype_list.count.to_string);
+ buf.append "]={\n";
+ (PROTOTYPE.prototype_list.lower).to (PROTOTYPE.prototype_list.upper-1) do {
+ j:INTEGER;
+ proto := PROTOTYPE.prototype_list.item j;
+ buf.append " \"";
+ append_escaped_string (proto.name) in buf;
+ buf.append " (";
+ append_escaped_string (proto.filename) in buf;
+ buf.append ")\",\n";
+ };
+ proto := PROTOTYPE.prototype_list.last;
+ buf.append " \"";
+ append_escaped_string (proto.name) in buf;
+ buf.append " (";
+ append_escaped_string (proto.filename) in buf;
+ buf.append ")\"\n};\n\n";
+ );
+
+ - generate_trace_codedata_in buf:STRING declarations_in decl:STRING <-
+ ( + src:HASHED_DICTIONARY[STRING,UINTEGER_32];
+ + key:UINTEGER_32;
+
+ //
+ // Source Code.
+ //
+
+ title "SOURCE LINE REFERENCE" in decl;
+
+ buf.append
+ "struct __source {\n\
+ \ unsigned int pos;\n\
+ \ char *line;\n\
+ \} __src[";
+ src := PUSH.source_line;
+ src.count.append_in buf;
+ buf.append "]={\n";
+ (src.lower).to (src.upper) do { j:INTEGER;
+ key := src.key j;
+ decl.append "#define L";
+ key.append_in decl;
+ decl.add_last ' ';
+ (j-1).append_in decl;
+ decl.add_last '\n';
+ //
+ buf.append " {";
+ key.append_in buf;
+ buf.append ",\"";
+ buf.append (src.item j);
+ buf.append "\"},\n";
+ };
+ buf.remove (buf.upper - 1);
+ buf.append "};\n\n";
+ );
+
+ - generate_trace_code_in buf:STRING <-
+ (
+
+ //
+ // Signal Manager
+ //
+
+ (is_ansi).if {
+ buf.append
+ "// Unix Signal manager:\n\
+ \void interrupt_signal(int sig) \n\
+ \{ \n\
+ \ stack_print(top_context); \n\
+ \ print_string(\"User interrupt.\\n\"); \n\
+ \ die_with_code(1); \n\
+ \} \n\n";
+ };
+
+ //
+ // Stack Manager
+ //
+
+ buf.append
+ "void push_first(_____CONTEXT *path,unsigned long code)\n\
- \{ \n";
++ \{ int n; _____CONTEXT *c; static int mx=0;\n";
+ (debug_level_option = 20).if {
+ buf.append
+ " _____CONTEXT *cur,loop;\n\
+ \ cur = top_context; \n\
+ \ while ((cur != (void *)0) && (cur != path)) cur = cur->back; \n\
+ \ if (cur == path) {\n\
+ \ loop.back = top_context;\n\
+ \ loop.code = code; \n\
+ \ stack_print(&loop);\n\
+ \ print_string(\"COMPILER : Debug context looping detected !\\n\");\n\
+ \ die_with_code(1);\n\
+ \ };\n";
+ };
+ buf.append
+ " path->back = top_context;\n\
+ \ path->code = code;\n\
+ \ top_context = path;\n\
++ \ \n\
++ \ /*c = path; n=0;\n\
++ \ while (c != NULL) { n++; c = c->back; };\n\
++ \ if ((n > mx) ) { print_integer(n); print_string(\"\\n\"); mx = n; };*/ \n\
+ \} \n\
+ \ \n\
+ \void push(_____CONTEXT *path,unsigned long code)\n\
+ \{ \n\
+ \ path->code = code;\n\
+ \ top_context = path;\n\
+ \} \n\
+ \ \n\
+ \void stack_print(_____CONTEXT *up) \n\
+ \{ _____CONTEXT *back,*next; \n\
+ \ int j; \n\
+ \ next = (void *)0; \n\
+ \ while (up != (void *)0) { \n\
+ \ back = up -> back; \n\
+ \ up -> back = next; \n\
+ \ next = up; \n\
+ \ up = back; \n\
+ \ }; \n\
+ \ print_string(\"\\n============== BOTTOM ==============\\n\"); \n\
+ \ while (next != (void *)0) { \n";
+ (debug_with_code).if {
+ buf.append
+ " print_string(\"Line #\"); \n\
+ \ print_integer(__src[next->code].pos >> 17); \n\
+ \ print_string(\" Column #\"); \n\
+ \ print_integer((__src[next->code].pos >> 9) & 0xFF); \n\
+ \ print_string(\" in \"); \n\
+ \ print_string(trace[__src[next->code].pos & 0x1FF]); \n\
+ \ print_string(\".\\n\"); \n\
+ \ if ((__src[next->code].pos & 0x1FF) != 0) { \n\
+ \ print_string(__src[next->code].line); \n\
+ \ print_char('\\n'); \n\
+ \ for (j=0;j < ((__src[next->code].pos >> 9) & 0xFF);j++) {\n\
+ \ if (__src[next->code].line[j]=='\\t') print_char('\\t');\n\
+ \ else print_char(' ');\n\
+ \ }; \n\
+ \ print_char('^'); \n\
+ \ print_char('\\n'); \n\
+ \ }; \n";
+
+ } else {
+ buf.append
+ " print_string(\"Line #\"); \n\
+ \ print_integer(next->code >> 17); \n\
+ \ print_string(\" Column #\"); \n\
+ \ print_integer((next->code >> 9) & 0xFF); \n\
+ \ print_string(\" in \"); \n\
+ \ print_string(trace[next->code & 0x1FF]); \n\
+ \ print_string(\".\\n\"); \n";
+ };
+ buf.append
+ " next = next -> back; \n\
+ \ }; \n\
+ \ print_string(\"================ TOP ===============\\n\"); \n\
+ \ top_context = (void *)0; \n\
+ \} \n\
+ \ \n\
+ \void print_integer(unsigned short n) \n\
+ \{ unsigned short val; \n\
+ \ char car; \n\
+ \ car = (n % 10) + '0'; \n\
+ \ val = n / 10; \n\
+ \ if (val != 0) print_integer(val); \n\
+ \ print_char(car); \n\
+ \} \n\n";
+
+ );
+
--
Lisaac compiler
More information about the Lisaac-commits
mailing list