add function BEDefineRuleTypeWithCode to backend for functions implemented in abc code

backend/Mac/Clean System Files/backend_library

@@ -64,6 +64,7 @@ BENoStrictNodeIds
 BERule
 BEDeclareRuleType
 BEDefineRuleType
+BEDefineRuleTypeWithCode
 BEAdjustArrayFunction
 BENoRules
 BERules

backend/Windows/Clean System Files/backend_library

@@ -64,6 +64,7 @@ BENoStrictNodeIds
 BERule
 BEDeclareRuleType
 BEDefineRuleType
+BEDefineRuleTypeWithCode
 BEAdjustArrayFunction
 BENoRules
 BERules

backend/backend.dcl

@@ -161,6 +161,8 @@ BEDeclareRuleType :: !Int !Int !String !BackEnd -> BackEnd;
 // void BEDeclareRuleType (int functionIndex,int moduleIndex,CleanString name);
 BEDefineRuleType :: !Int !Int !BETypeAltP !BackEnd -> BackEnd;
 // void BEDefineRuleType (int functionIndex,int moduleIndex,BETypeAltP typeAlt);
+BEDefineRuleTypeWithCode :: !Int !Int !BETypeAltP !BECodeBlockP !BackEnd -> BackEnd;
+// void BEDefineRuleTypeWithCode (int functionIndex,int moduleIndex,BETypeAltP typeAlt,BECodeBlockP codeBlock);
 BEAdjustArrayFunction :: !BEArrayFunKind !Int !Int !BackEnd -> BackEnd;
 // void BEAdjustArrayFunction (BEArrayFunKind arrayFunKind,int functionIndex,int moduleIndex);
 BENoRules :: !BackEnd -> (!BEImpRuleP,!BackEnd);

backend/backend.icl

@@ -430,6 +430,12 @@ BEDefineRuleType a0 a1 a2 a3 = code {
 }
 // void BEDefineRuleType (int functionIndex,int moduleIndex,BETypeAltP typeAlt);
 
+BEDefineRuleTypeWithCode :: !Int !Int !BETypeAltP !BECodeBlockP !BackEnd -> BackEnd;
+BEDefineRuleTypeWithCode a0 a1 a2 a3 a4 = code {
+	ccall BEDefineRuleTypeWithCode "IIpp:V:p"
+}
+// void BEDefineRuleTypeWithCode (int functionIndex,int moduleIndex,BETypeAltP typeAlt,BECodeBlockP codeBlock);
+
 BEAdjustArrayFunction :: !BEArrayFunKind !Int !Int !BackEnd -> BackEnd;
 BEAdjustArrayFunction a0 a1 a2 a3 = code {
 	ccall BEAdjustArrayFunction "III:V:p"

backendC/CleanCompilerSources/backend.c

@@ -2390,6 +2390,30 @@ BEDefineRuleType (int functionIndex, int moduleIndex, BETypeAltP typeAlt)
 	sdef->sdef_rule_type	= ruleType;
 } /* BEDefineRuleType */
 
+void
+BEDefineRuleTypeWithCode (int functionIndex, int moduleIndex, BETypeAltP typeAlt, BECodeBlockP codeBlock)
+{
+	SymbolP		functionSymbol;
+	SymbDef		sdef;
+	RuleTypes	ruleType;
+	BEModule	module;
+
+	ruleType	= ConvertAllocType (struct rule_type);
+	ruleType->rule_type_rule	= typeAlt;
+
+	module	= &gBEState.be_modules [moduleIndex];
+	functionSymbol	= &module->bem_functions [functionIndex];
+
+	sdef	= functionSymbol->symb_def;
+	Assert (sdef->sdef_kind == NEWDEFINITION);
+	sdef->sdef_arity		= typeAlt->type_alt_lhs->type_node_arity;
+	sdef->sdef_arfun		= NoArrayFun;
+	sdef->sdef_kind 		= module->bem_isSystemModule ? SYSRULE : DEFRULE;
+	sdef->sdef_rule_type	= ruleType;
+	sdef->sdef_abc_code = codeBlock->co_instr;
+	sdef->sdef_mark |= SDEF_DEFRULE_ABC_CODE;
+}
+
 void
 BEAdjustArrayFunction (BEArrayFunKind arrayFunKind, int functionIndex, int moduleIndex)
 {

backendC/CleanCompilerSources/backend.h

@@ -360,6 +360,9 @@ Clean (BEDeclareRuleType :: Int Int String BackEnd -> BackEnd)
 void BEDefineRuleType (int functionIndex, int moduleIndex, BETypeAltP typeAlt);
 Clean (BEDefineRuleType :: Int Int BETypeAltP BackEnd -> BackEnd)
 
+void BEDefineRuleTypeWithCode (int functionIndex, int moduleIndex, BETypeAltP typeAlt, BECodeBlockP codeBlock);
+Clean (BEDefineRuleTypeWithCode :: Int Int BETypeAltP BECodeBlockP BackEnd -> BackEnd)
+
 void BEAdjustArrayFunction (BEArrayFunKind arrayFunKind, int functionIndex, int moduleIndex);
 Clean (BEAdjustArrayFunction :: BEArrayFunKind Int Int BackEnd -> BackEnd)
 

backendC/CleanCompilerSources/checker_2.c

@@ -61,7 +61,8 @@ void ReadInlineCode (void)
 					SymbDef sdef;
 
 					sdef=function_symbol_a[i].symb_def;
-					if (sdef->sdef_kind==SYSRULE && sdef->sdef_mark & SDEF_USED_STRICTLY_MASK)
+					if (sdef->sdef_kind==SYSRULE &&
+						(sdef->sdef_mark & (SDEF_USED_STRICTLY_MASK | SDEF_DEFRULE_ABC_CODE))==SDEF_USED_STRICTLY_MASK)
 						break;
 				}
 

backendC/CleanCompilerSources/codegen2.c

@@ -2615,8 +2615,10 @@ static void FillSymbol (Node node,SymbDef sdef,int *asp_p,int *bsp_p,NodeId upda
 						*asp_p-=a_size;
 						*bsp_p-=b_size;
 
-						if (! (sdef->sdef_kind==SYSRULE && (sdef->sdef_mark & SDEF_DEFRULE_INSTRUCTIONS)!=0
-								&& sdef->sdef_instructions!=NULL && *sdef->sdef_instructions!='\0' && *sdef->sdef_instructions!='.'))
+						if (! (sdef->sdef_kind==SYSRULE &&
+								(  (sdef->sdef_mark & SDEF_DEFRULE_INSTRUCTIONS)!=0 && sdef->sdef_instructions!=NULL && *sdef->sdef_instructions!='\0' && *sdef->sdef_instructions!='.')
+								|| (sdef->sdef_mark & SDEF_DEFRULE_ABC_CODE)!=0 && sdef->sdef_abc_code!=NULL && sdef->sdef_abc_code->instr_this[0]!='.')
+							  )
 						{
 							cleanup_stack (asp_p,bsp_p,a_size,b_size,&code_gen_node_ids_p->a_node_ids,&code_gen_node_ids_p->b_node_ids,
 											&code_gen_node_ids_p->free_node_ids,code_gen_node_ids_p->moved_node_ids_l,
@@ -2640,8 +2642,10 @@ static void FillSymbol (Node node,SymbDef sdef,int *asp_p,int *bsp_p,NodeId upda
 						*asp_p-=a_size+1;
 						*bsp_p-=b_size;
 
-						if (! (sdef->sdef_kind==SYSRULE && (sdef->sdef_mark & SDEF_DEFRULE_INSTRUCTIONS)!=0
-								&& sdef->sdef_instructions!=NULL && *sdef->sdef_instructions!='\0' && *sdef->sdef_instructions!='.'))
+						if (! (sdef->sdef_kind==SYSRULE &&
+								(  (sdef->sdef_mark & SDEF_DEFRULE_INSTRUCTIONS)!=0 && sdef->sdef_instructions!=NULL && *sdef->sdef_instructions!='\0' && *sdef->sdef_instructions!='.')
+								|| (sdef->sdef_mark & SDEF_DEFRULE_ABC_CODE)!=0 && sdef->sdef_abc_code!=NULL && sdef->sdef_abc_code->instr_this[0]!='.')
+							  )
 						{
 							cleanup_stack (asp_p,bsp_p,a_size+1,b_size,&code_gen_node_ids_p->a_node_ids,&code_gen_node_ids_p->b_node_ids,
 											&code_gen_node_ids_p->free_node_ids,code_gen_node_ids_p->moved_node_ids_l,
@@ -2663,8 +2667,10 @@ static void FillSymbol (Node node,SymbDef sdef,int *asp_p,int *bsp_p,NodeId upda
 						*asp_p-=a_size;
 						*bsp_p-=b_size;
 
-						if (! (sdef->sdef_kind==SYSRULE && (sdef->sdef_mark & SDEF_DEFRULE_INSTRUCTIONS)!=0
-								&& sdef->sdef_instructions!=NULL && *sdef->sdef_instructions!='\0' && *sdef->sdef_instructions!='.'))
+						if (! (sdef->sdef_kind==SYSRULE &&
+								(  (sdef->sdef_mark & SDEF_DEFRULE_INSTRUCTIONS)!=0 && sdef->sdef_instructions!=NULL && *sdef->sdef_instructions!='\0' && *sdef->sdef_instructions!='.')
+								|| (sdef->sdef_mark & SDEF_DEFRULE_ABC_CODE)!=0 && sdef->sdef_abc_code!=NULL && sdef->sdef_abc_code->instr_this[0]!='.')
+							  )
 						{
 							cleanup_stack (asp_p,bsp_p,a_size,b_size,&code_gen_node_ids_p->a_node_ids,&code_gen_node_ids_p->b_node_ids,
 											&code_gen_node_ids_p->free_node_ids,code_gen_node_ids_p->moved_node_ids_l,
@@ -4991,8 +4997,10 @@ static void FillUniqueNodeWithNode (NodeP update_node,int *asp_p,int *bsp_p,Code
 						*asp_p-=a_size;
 						*bsp_p-=b_size;
 
-						if (! (sdef->sdef_kind==SYSRULE && (sdef->sdef_mark & SDEF_DEFRULE_INSTRUCTIONS)!=0
-								&& sdef->sdef_instructions!=NULL && *sdef->sdef_instructions!='\0' && *sdef->sdef_instructions!='.'))
+						if (! (sdef->sdef_kind==SYSRULE &&
+								(  (sdef->sdef_mark & SDEF_DEFRULE_INSTRUCTIONS)!=0 && sdef->sdef_instructions!=NULL && *sdef->sdef_instructions!='\0' && *sdef->sdef_instructions!='.')
+								|| (sdef->sdef_mark & SDEF_DEFRULE_ABC_CODE)!=0 && sdef->sdef_abc_code!=NULL && sdef->sdef_abc_code->instr_this[0]!='.')
+							  )
 						{
 							cleanup_stack (asp_p,bsp_p,a_size,b_size,&code_gen_node_ids_p->a_node_ids,&code_gen_node_ids_p->b_node_ids,
 											&code_gen_node_ids_p->free_node_ids,code_gen_node_ids_p->moved_node_ids_l,

backendC/CleanCompilerSources/instructions.c

@@ -1297,6 +1297,24 @@ void GenOStackLayout (int asize,int bsize,Args fun_args)
 	}
 }
 
+static void GenABCInstructions (Instructions ilist)
+{
+	for (; ilist; ilist = ilist->instr_next){
+		char *instruction_name;
+		
+		instruction_name=ilist->instr_this;
+		
+		FPutC ('\n',OutFile);
+		if (instruction_name[0]==':')
+			FPutS (&instruction_name[1],OutFile);
+		else {
+			if (instruction_name[0]!='.')
+				FPutC ('\t',OutFile);
+			FPutS (instruction_name,OutFile);
+		}
+	}
+}
+
 static void CallFunction2 (Label label, SymbDef def, Bool isjsr, StateS root_state, Args fun_args, int arity)
 {
 	int ain,aout,bin,bout;
@@ -1322,7 +1340,14 @@ static void CallFunction2 (Label label, SymbDef def, Bool isjsr, StateS root_sta
 
 	if (def->sdef_kind==SYSRULE){
 		char  *instr;
-	
+
+		if (def->sdef_mark & SDEF_DEFRULE_ABC_CODE){
+			GenABCInstructions (def->sdef_abc_code);
+			if (!isjsr)
+				GenRtn (aout, bout, root_state);
+			return;
+		}
+
 		if (def->sdef_mark & SDEF_DEFRULE_INSTRUCTIONS)
 			instr = def->sdef_instructions;
 		else
@@ -3934,8 +3959,6 @@ void GenInstructions (Instructions ilist)
 			FPutS (instruction_name,OutFile);
 		}
 	}
-	if (!DoDebug)
-		FPutC ('\n',OutFile);
 }
 
 void GenTestCaf (Label label)

backendC/CleanCompilerSources/scanner_2.c

@@ -288,7 +288,7 @@ void ScanInlineFile (char *fname,TableKind system_module_table_kind)
 		*tail = '\0';
 		if (! (instrid = RetrieveFromSymbolTable (instr,system_module_table_kind)))
 			continue;
-		if (instrid->ident_sys_rule_def==NULL)
+		if (instrid->ident_sys_rule_def==NULL || (instrid->ident_sys_rule_def->sdef_mark & SDEF_DEFRULE_ABC_CODE)!=0)
 			continue;
 		if ((instrid->ident_mark & INLINE_MASK) != 0)
 		{

backendC/CleanCompilerSources/syntaxtr.t

@@ -539,6 +539,7 @@ STRUCT (symbol_def,SymbDef){
 		struct symbol_def *typeinfo_dictionary_field; /* for IMPRULE if SDEF_INSTANCE_RULE_WITH_FIELD_P */
 		struct symbol_def *typeinfo_instance_rule; /* for IMPRULE if SDEF_RULE_INSTANCE_RULE_P */
 		char * typeinfo_instructions; /* for DEFRULE or SYSRULE if SDEF_DEFRULE_INSTRUCTIONS */
+		Instructions typeinfo_abc_code; /* for DEFRULE or SYSRULE if SDEF_DEFRULE_ABC_CODE */
 	} sdef_typeinfo;
 
 	unsigned		sdef_number;
@@ -597,6 +598,7 @@ STRUCT (symbol_def,SymbDef){
 #define SDEF_INSTANCE_RULE_WITH_FIELD_P 16384
 #define SDEF_RULE_INSTANCE_RULE_P 32768
 #define SDEF_HAS_SPECIAL_ARRAY_FUNCTION 512
+#define SDEF_DEFRULE_ABC_CODE 2048
 #define SDEF_DEFRULE_INSTRUCTIONS 16
 #define SDEF_WARNED_NO_INLINE_CODE 65536
 
@@ -618,6 +620,7 @@ STRUCT (symbol_def,SymbDef){
 #define sdef_dictionary_field	sdef_typeinfo.typeinfo_dictionary_field
 #define sdef_instance_rule	sdef_typeinfo.typeinfo_instance_rule
 #define sdef_instructions	sdef_typeinfo.typeinfo_instructions
+#define sdef_abc_code	sdef_typeinfo.typeinfo_abc_code
 
 #if IMPORT_OBJ_AND_LIB
 struct string_list {

backendC/backend.def

@@ -66,6 +66,7 @@ EXPORTS
  BERule
  BEDeclareRuleType
  BEDefineRuleType
+ BEDefineRuleTypeWithCode
  BEAdjustArrayFunction
  BENoRules
  BERules

backendC/backend.link

@@ -65,6 +65,7 @@
 /EXPORT: BERule
 /EXPORT: BEDeclareRuleType
 /EXPORT: BEDefineRuleType
+/EXPORT: BEDefineRuleTypeWithCode
 /EXPORT: BEAdjustArrayFunction
 /EXPORT: BENoRules
 /EXPORT: BERules

backendC/backend.link64

@@ -63,6 +63,7 @@
 /EXPORT:BERule
 /EXPORT:BEDeclareRuleType
 /EXPORT:BEDefineRuleType
+/EXPORT:BEDefineRuleTypeWithCode
 /EXPORT:BEAdjustArrayFunction
 /EXPORT:BENoRules
 /EXPORT:BERules