static void
_remove_incompatible_uses(pri *def) /* must be the definition module descriptor */
/* Locks: requires ProcListLock. acquires nothing. */
{
pri *use;
if (!PriExported(def))
return ;
for(use = DidPtr(PriDid(def))->procedure; use; use = use->nextproc)
{
if (PriIsProxy(use) && use->module_ref == def->module_ref)
{
if (!_compatible_def_use(def, use))
{
/* attempt to undo the impossible def-use link */
switch (PriScope(use))
{
case IMPORT: Pri_Set_Scope(use, LOCAL); break;
case IMPEXP: Pri_Set_Scope(use, EXPORT); break;
case QUALI: break;
}
use->module_ref = use->module_def;
}
}
}
}
static void
_update_all_uses(pri *def) /* must be the definition module descriptor */
/* Locks: requires ProcListLock. acquires nothing. */
{
pri *use;
if (!PriExported(def))
return;
for(use = DidPtr(PriDid(def))->procedure; use; use = use->nextproc)
{
if (PriIsProxy(use) && use->module_ref == def->module_ref)
{
_update_def_use(def, use);
}
}
}
/*
_tool_code(proc, debug)
- makes the code for a tool interface
*/
static vmcode *
_tool_code(pri *procb, int debug)
{
vmcode *code;
vmcode *save;
if (PriCodeType(procb) & VMCODE)
{
Allocate_Default_Procedure(3 + (debug?DEBUG_LENGTH:0), PriDid(procb));
save = code;
if (debug) {
Store_3(Debug_call, procb, CALL_PORT|FIRST_CALL|LAST_CALL);
Store_4d(d_.empty,0,0,0);
}
Store_i(JmpdP);
Store_d(procb);
Store_i(Code_end);
return save;
}
else
{
return procb->code.vmc; /* use the body's code */
}
}
vmcode *
print_am(register vmcode *code,
vmcode **label,
int *res,
int option) /* ALS|PROCLAB */
{
dident did1;
int inst;
if (*label == code)
*label = NULL; /* the label is about to being printed */
if (InvalidAddress(code))
inst = Inst_Error;
else
inst = Get_Int_Opcode(code++);
if (inst < 0 || inst > NUMBER_OP)
{
p_fprintf(current_output_, "Undefined opcode in print_am: %d",
inst);
code = 0;
*res = PFAIL;
}
if (inst == Code_end) {
*res = PSUCCEED;
return 0;
}
else if (inst == Comment)
return (vmcode *) code + (*code + 1);
else
{
#ifdef PRINTAM
if (option & PROCLAB) /* try to print the location */
{
extern pri *ec_code_procedure(vmcode *code);
pri *pd = ec_code_procedure(code-1);
if (pd)
p_fprintf(current_output_,"%s/%d+%d:\n",
DidName(PriDid(pd)), DidArity(PriDid(pd)),
code - PriCode(pd) - 1);
}
#endif
p_fprintf(current_output_, "\t%s\t", inst_name[inst]);
switch (inst)
{
case Failure:
case Nop:
case Clause:
break;
case Read_void:
case Read_variable:
case Read_reference:
case Read_nil:
case Read_test_var:
case Write_variable:
case Write_void:
case Write_nil:
case Write_list:
case Write_first_list:
case Match_meta:
case Match_last_meta:
case First:
case Push_void:
case Push_variable:
case Push_nil:
case Push_list:
case Puts_variable:
case Puts_list:
case Puts_nil:
case Occur_check_next:
case Dfid_test:
#if (NREGTMP > 0)
case FirstTR:
#endif /* NREGTMP */
case Inst_Error:
case Continue_after_exception:
case Refail:
break;
case Write_named_void:
case Write_named_variable:
case Push_self_reference:
case Write_meta:
NamedVar;
break;
case CutAM:
case MoveAM:
case Get_nilAM:
case Out_get_nilAM:
case In_get_nilAM:
case Read_variableAM:
case Read_referenceAM:
case Read_valueAM:
case Read_matched_valueAM:
case Write_valueAM:
case Write_local_valueAM:
case Put_nilAM:
case Out_get_listAM:
case Get_list_argumentsAM:
case Get_structure_argumentsAM:
case Write_variableAM:
case Put_variableAM:
case Put_global_variableAM:
case Put_listAM:
case Push_variableAM:
case Push_valueAM:
case Push_local_valueAM:
case Puts_valueAM:
case SavecutAM:
case BI_Exit:
case BI_SetBipError:
case BI_GetBipError:
case BI_Free:
case BI_Var:
case BI_NonVar:
case BI_Atom:
case BI_Integer:
case BI_Float:
case BI_Breal:
case BI_Real:
case BI_Rational:
case BI_String:
case BI_Number:
case BI_Atomic:
case BI_Compound:
case BI_Meta:
case BI_IsSuspension:
case BI_IsHandle:
case BI_IsEvent:
case BI_IsList:
case BI_Bignum:
case BI_Callable:
Am;
break;
case Write_named_variableAM:
case Put_named_variableAM:
Am;
NamedVar;
break;
case Put_named_variableAML:
Am;
Perm;
NamedVar;
break;
case Put_referenceAM:
Am;
case Puts_reference:
VarOffset;
NamedVar;
break;
case Put_referenceAML:
Am;
case Puts_referenceL:
Perm;
VarOffset;
NamedVar;
break;
case Move3AMAM:
Am;
/* fall through */
case ShiftAMAMAMAMAM:
Am;
/* fall through */
case ShiftAMAMAMAM:
case Move2AMAM:
Am;
/* fall through */
case ShiftAMAMAM:
case RotAMAMAM:
case BI_NotIdentList:
Am;
/* fall through */
case BI_Identical:
case BI_NotIdentical:
case BI_Inequality:
case SwapAMAM:
case Read_variable2AM:
case Write_variable2AM:
case Write_local_value2AM:
case Push_local_value2AM:
case Put_variable2AM:
Am;
Am;
break;
case BI_MakeSuspension:
Am;
/* fall through */
case BI_Add:
case BI_Sub:
case BI_Mul:
case BI_Quot:
case BI_Div:
case BI_Rem:
case BI_FloorDiv:
case BI_FloorRem:
case BI_And:
case BI_Or:
case BI_Xor:
case BI_Lt:
case BI_Le:
case BI_Gt:
case BI_Ge:
case BI_Eq:
case BI_Ne:
case BI_Arg:
Am;
/* fall through */
case BI_Minus:
case BI_Bitnot:
case BI_CutToStamp:
case BI_Arity:
Am;
Am;
ArgDesc;
break;
case BI_Addi:
Am;
Integer;
Am;
ArgDesc;
break;
#define NREGARG 0
#if (NREGARG > 0)
case MoveAR:
case Get_nilAR:
case Out_get_nilAR:
case In_get_nilAR:
case Read_variableAR:
case Read_valueAR:
case Read_matched_valueAR:
case Write_valueAR:
case Write_local_valueAR:
case Put_nilAR:
case Out_get_listAR:
case Get_list_argumentsAR:
case Get_structure_argumentsAR:
case Write_variableAR:
case Put_variableAR:
case Put_listAR:
case Push_variableAR:
case Push_valueAR:
case Push_local_valueAR:
case Puts_variableAR:
case Puts_valueAR:
case Test_varAR:
case Test_groundAR:
case Push_referenceAR:
Ar;
break;
case Write_named_variableAR:
case Put_named_variableAR:
Ar;
NamedVar;
break;
#endif /* NREGARG */
case Read_variableL:
case Read_referenceL:
case Write_variableL:
case Read_valueL:
case Read_matched_valueL:
case Write_valueL:
case Write_local_valueL:
case Push_init_variableL:
case Push_variableL:
case Push_valueL:
case Push_local_valueL:
case Puts_variableL:
case Puts_valueL:
case Put_global_variableL:
Perm;
break;
case Write_named_variableL:
case Put_named_variableL:
Perm;
NamedVar;
break;
case Initialize:
code = _print_init_mask(code, 0);
break;
case Initialize_named:
code = _print_init_mask(code, 1);
break;
case Read_valueTM:
case Read_matched_valueTM:
case Match_next_metaTM:
case Match_metaTM:
case Write_valueTM:
case Write_local_valueTM:
case NextTM:
case ModeTM:
case Push_valueTM:
case Push_local_valueTM:
case Puts_valueTM:
case Write_next_listTM:
Temp;
break;
#if (NREGTMP > 0)
case Read_valueTR:
case Read_matched_valueTR:
case Write_valueTR:
case Write_local_valueTR:
case NextTR:
case ModeTR:
case Push_valueTR:
case Push_local_valueTR:
case Puts_valueTR:
case Push_variableTR:
case Read_variableTR:
case Write_variableTR:
case Push_referenceTR:
TempR;
break;
case Write_named_variableTR:
TempR;
NamedVar;
break;
#endif /* NREGTMP */
case Move3AML:
Am;
Perm;
case Move2AML:
case Put_global_variable2AML:
Am;
Perm;
case MoveAML:
case Get_valueAML:
case Get_matched_valueAML:
case Put_variableAML:
case Put_unsafe_valueAML:
case Put_global_variableAML:
case Read_variable2AML:
case Write_variable2AML:
Am;
Perm;
break;
case MoveNAML:
Integer;
Am;
Perm;
break;
#if (NREGARG > 0)
case MoveARL:
case Get_valueARL:
case Get_matched_valueARL:
case Put_variableARL:
case Put_unsafe_valueARL:
Ar;
Perm;
break;
case Put_named_variableARL:
Ar;
Perm;
NamedVar;
break;
#endif /* NREGARG */
case Put_unsafe_valueAMTM:
case Get_valueAMTM:
case Get_matched_valueAMTM:
Am;
Temp;
break;
case MoveTMAM:
Temp;
Am;
break;
#if (NREGARG > 0)
case MoveARAM:
Ar;
Am;
break;
#endif /* NREGARG */
#if (NREGARG > 0 && NREGTMP > 0)
case MoveTRAR:
TempR;
Ar;
break;
#endif /* NREGARG && NREGTMP */
#if (NREGTMP > 0)
case MoveTRAM:
TempR;
Am;
break;
#endif /* NREGTMP */
#if (NREGARG > 0)
case MoveTMAR:
Temp;
Ar;
break;
#endif /* NREGARG */
#if (NREGTMP > 0)
case Get_valueAMTR:
case Get_matched_valueAMTR:
case MoveAMTR:
Am;
TempR;
break;
#endif /* NREGTMP */
#if (NREGARG > 0)
case Put_unsafe_valueARTM:
case Get_valueARTM:
case Get_matched_valueARTM:
Ar;
Temp;
break;
#endif /* NREGARG */
#if (NREGARG > 0 && NREGTMP > 0)
case Get_valueARTR:
case Get_matched_valueARTR:
case MoveARTR:
Ar;
TempR;
break;
#endif /* NREGARG && NREGTMP */
case Get_variableNAML:
VarOffset;
Am;
Perm;
break;
case Move3LAM:
Perm;
Am;
case Move2LAM:
Perm;
Am;
case MoveLAM:
Perm;
Am;
break;
case MoveNLAM:
Integer;
Perm;
Am;
break;
#if (NREGARG > 0)
case Get_variableNARL:
VarOffset;
Ar;
Perm;
break;
case MoveLAR:
Perm;
Ar;
break;
#endif /* NREGARG */
case MoveAMAM:
case Get_valueAMAM:
case Get_matched_valueAMAM:
Am;
Am;
break;
case Move3LL:
Perm;
Perm;
/* falls through */
case Move2LL:
Perm;
Perm;
/* falls through */
case MoveLL:
case Get_valueLL:
case Write_variable2L:
case Write_local_value2L:
case Push_local_value2L:
case Read_variable2L:
Perm;
Perm;
break;
#if (NREGARG > 0)
case MoveAMAR:
case Get_valueAMAR:
case Get_matched_valueAMAR:
Am;
Ar;
break;
#endif /* NREGARG */
case Get_atom2AM:
Am;
Atom;
case Get_atomAM:
case Out_get_atomAM:
case In_get_atomAM:
case Put_atomAM:
case Put_moduleAM:
Am;
Atom;
break;
#if (NREGARG > 0)
case Get_atomAR:
case Out_get_atomAR:
case In_get_atomAR:
case Put_atomAR:
Ar;
Atom;
break;
#endif /* NREGARG */
case Get_atomintegerAMAM:
Am;
Atom;
Am;
Integer;
break;
case Get_integer2AM:
Am;
Integer;
case Get_integerAM:
case Out_get_integerAM:
case In_get_integerAM:
case Put_integerAM:
Am;
Integer;
break;
#if (NREGARG > 0)
case Get_integerAR:
case Out_get_integerAR:
case In_get_integerAR:
case Put_integerAR:
Ar;
Integer;
break;
#endif /* NREGARG */
case Get_floatAM:
case In_get_floatAM:
case Out_get_floatAM:
case Put_floatAM:
Am;
Float;
break;
#if (NREGARG > 0)
case Get_floatAR:
case In_get_floatAR:
case Out_get_floatAR:
case Put_floatAR:
Ar;
Float;
break;
#endif /* NREGARG */
case Get_stringAM:
case In_get_stringAM:
case Out_get_stringAM:
case Put_stringAM:
Am;
String;
break;
#if (NREGARG > 0)
case Get_stringAR:
case In_get_stringAR:
case Out_get_stringAR:
case Put_stringAR:
Ar;
String;
break;
#endif /* NREGARG */
case Get_structureAM:
case In_get_structureAM:
Am;
Structure;
Code_Label;
break;
case Put_structureAM:
case Out_get_structureAM:
Am;
Structure;
break;
#if (NREGARG > 0)
case Get_structureAR:
case In_get_structureAR:
Ar;
Structure;
Code_Label;
break;
case Out_get_structureAR:
case Put_structureAR:
Ar;
Structure;
break;
#endif /* NREGARG */
case Get_listAM:
case In_get_listAM:
case In_get_metaAM:
Am;
Code_Label;
break;
case Get_metaAM:
Am;
NamedVar;
break;
#if (NREGARG > 0)
case Get_listAR:
case In_get_listAR:
Ar;
Code_Label;
break;
#endif /* NREGARG */
case Read_variableNL:
case Read_referenceNL:
case Write_variableNL:
VarOffset;
Perm;
break;
case Write_named_variableNL:
VarOffset;
Perm;
NamedVar;
break;
case Read_atom2:
Atom;
/* falls through */
case Read_atom:
case Puts_atom:
Atom;
break;
case Read_atominteger:
Atom;
Integer;
break;
case Read_integeratom:
Integer;
Atom;
break;
case Read_integer2:
case Write_integer2:
Integer;
/* falls through */
case Read_integer:
case Write_integer:
case Push_integer:
case Puts_integer:
case Exit_emulator:
case Bounce:
Integer;
break;
case Read_float:
case Write_float:
case Push_float:
case Puts_float:
Float;
break;
case Read_string:
case Write_string:
case Push_string:
case Puts_string:
String;
break;
case Write_did2:
Structure;
/* falls through */
case Write_structure:
case Write_first_structure:
case Write_did:
case Puts_structure:
Structure;
break;
case Write_didinteger:
Structure;
Integer;
break;
case Write_integerdid:
Integer;
Structure;
break;
case Read_structure:
case Read_last_structure:
Structure;
Code_Label;
break;
case Read_meta:
case Read_last_meta:
NamedVar;
case Read_list:
case Read_last_list:
Code_Label;
break;
case Read_structureTM:
case Read_next_structureTM:
case Write_next_structureTMlab:
Structure;
case NextTMlab:
case ModeTMlab:
case Read_listTM:
case Read_next_listTM:
case Write_next_listTMlab:
Temp;
Code_Label;
break;
case Write_next_structureTM:
Structure;
Temp;
break;
case Read_metaTM:
case Read_next_metaTM:
Temp;
NamedVar;
Code_Label;
break;
#if (NREGTMP > 0)
case Read_structureTR:
case Read_next_structureTR:
Structure;
case NextTRlab:
case ModeTRlab:
case Read_listTR:
case Read_next_listTR:
TempR;
Code_Label;
break;
case Get_constantAR:
case Out_get_constantAR:
case In_get_constantAR:
Ar; Const; Consttag;
break;
case Put_constantAR:
Ar; Consttag; Const;
break;
#endif /* NREGTMP */
case Puts_constant:
Consttag; Const;
break;
case Read_constant:
case Write_constant:
case Push_constant:
Const; Consttag;
break;
case Get_constantAM:
case Out_get_constantAM:
case In_get_constantAM:
Am; Const; Consttag;
break;
case Put_constantAM:
Am; Consttag; Const;
break;
case Retry_me_else:
case Retry:
Port;
Code_Label;
break;
case Retry_inline:
Port;
Code_Label;
EnvDesc;
break;
case Trust:
Port;
Code_Label;
Nl;
break;
case Trust_inline:
Port;
Code_Label;
EnvDesc;
Nl;
break;
case Branchs:
VarOffset;
case Branch:
Code_Label;
break;
case Set_bp:
case New_bp:
Code_Label;
break;
case Try_me_else:
Port;
Integer;
Code_Label;
break;
case Retry_me_inline:
Port;
Code_Label;
EnvDesc;
break;
case Trust_me_inline:
Port;
EnvDesc;
break;
case Try_parallel:
{
long nalt;
uword *ptr;
nalt = (long) *code;
Integer;
Integer;
ptr = (uword *) *code++;
if (ptr)
{
do
{
p_fprintf(current_output_, "\n\t\t\t\t");
_print_label((vmcode **) ptr);
ptr++;
} while (nalt--);
}
}
break;
case Retry_seq:
case Try_clause:
Addr;
break;
case GuardL:
VarOffset;
Code_Label;
break;
case Try:
Port;
Integer;
Code_Label;
break;
case Trylab:
Port;
Integer;
Code_Label;
Code_Label;
Nl;
break;
case Retrylab:
Port;
Code_Label;
Code_Label;
Nl;
break;
case Try_me_dynamic:
case Retry_me_dynamic:
#ifdef OLD_DYNAMIC
Integer;
Integer;
Save_Label;
if (*code == SRC_CLAUSE_ARITY)
p_fprintf(current_output_,"SOURCE ");
p_fprintf(current_output_,"%d ",
(*code++) & SRC_CLAUSE_ARITY_MASK);
Code_Label;
#endif
break;
case Push_referenceAM:
Am;
case Allocate:
case Wake_init:
case Space:
case Exits:
case Push_structure:
case Push_reference:
case Push_void_reference:
case Read_attribute:
case Read_voidN:
case Write_voidN:
case Push_voidN:
case Puts_valueG:
case Push_valueG:
VarOffset;
break;
case Gc_testA:
Integer;
case Gc_test:
case Gc:
Integer;
break;
case Cut:
case Cut_single:
VarOffset;
break;
case MoveLAMCallfA:
Perm;
Am;
case CallfA:
case CallA:
Addr;
EnvDesc;
break;
case Put_global_variableAMLCallfA:
Am;
Perm;
Addr;
EnvDesc;
break;
case JmpdAs:
VarOffset;
case JmpA:
case JmpdA:
case ChainA:
case ChaincA:
case ChaindA:
case Meta_jmpA:
Addr;
Nl;
break;
case MoveLAMChainA:
Perm;
Am;
Addr;
Nl;
break;
case MoveLAMCallfP:
Perm;
Am;
case CallfP:
case CallP:
Proc;
case Metacall:
case Handler_call:
case Suspension_call:
case Fail_clause:
EnvDesc;
break;
case Put_global_variableAMLCallfP:
Am;
Perm;
Proc;
EnvDesc;
break;
case Fastcall:
Port;
EnvDesc;
break;
case MoveLAMChainP:
Perm;
Am;
case JmpP:
case JmpdP:
case ChainP:
case ChaincP:
case ChaindP:
Proc;
Nl;
break;
case Ret:
case Retn:
case Retd:
case Retd_nowake:
case Ret_nowake:
case Exit:
case Exitd:
case Exitd_nowake:
case Exitc:
Nl;
break;
case Savecut:
case Neckcut:
case Neckcut_par:
case Deallocate:
case Restore_bp:
case Catch:
case Throw:
case Meta_jmp:
case Suspension_jmp:
case Explicit_jmp:
case Wake:
break;
case Trust_me:
Port;
break;
case SavecutL:
case SoftcutL:
case Dfid_testL:
case Depth:
Perm;
break;
case CutL:
case Push_referenceL:
case Push_init_referenceL:
Perm;
VarOffset;
break;
case CutAMN:
Am;
VarOffset;
break;
case ExtCall:
ExtCallName;
break;
case Escape:
EsuName;
break;
case External:
case External0:
case External1:
case External2:
case External3:
case Call_dynamic:
Proc;
Addr;
break;
case Debug_call:
Proc;
Port;
Atom;
Integer;
Integer;
Integer;
break;
case Debug_call_simple:
Proc;
Port;
Atom;
Integer;
Integer;
Integer;
case Debug_exit_simple_args:
Integer; /* argument descriptor minitags */
Integer; /* offset */
case Debug_exit_simple:
break;
case List_switchL:
Perm;
goto _list_switch_;
case List_switchAM:
Am;
_list_switch_:
if (option & ALS) {
Code_Label;
Code_Label;
Code_Label;
}
break;
#if (NREGARG > 0)
case List_switchAR:
Ar;
if (option & ALS) {
Code_Label;
Code_Label;
Code_Label;
}
break;
#endif /* NREGARG */
#if (NREGARG > 0)
case Atom_switchAR:
Ar;
if (option & ALS) {
Atom_Table2;
Code_Label;
}
break;
#endif /* NREGARG */
case Atom_switchL:
Perm;
goto _atom_switch_;
case Atom_switchAM:
Am;
_atom_switch_:
if (option & ALS) {
Atom_Table2;
Code_Label;
}
break;
case Functor_switchL:
Perm;
goto _functor_switch_;
case Functor_switchAM:
Am;
_functor_switch_:
if (option & ALS) {
Functor_Table2;
Code_Label;
}
break;
#if (NREGARG > 0)
case Functor_switchAR:
Ar;
if (option & ALS) {
Functor_Table2;
Code_Label;
}
break;
#endif /* NREGARG */
case Integer_switchL:
Perm;
goto _integer_switch_;
case Integer_switchAM:
Am;
_integer_switch_:
if (option & ALS) {
Integer_Table2;
Code_Label;
}
break;
#if (NREGARG > 0)
case Integer_switchAR:
Ar;
if (option & ALS) {
Integer_Table2;
Code_Label;
}
break;
#endif /* NREGARG */
case Integer_range_switchL:
Perm;
goto _integer_range_switch_;
case Integer_range_switchAM:
Am;
_integer_range_switch_:
if (option & ALS) {
Integer_Range_Table;
}
break;
case Switch_on_typeL:
Perm;
goto _switch_on_type_;
case Switch_on_typeAM:
Am;
_switch_on_type_:
if (option & ALS)
{
int i;
for (i = 0; i < NTYPES; i++)
{
p_fprintf(current_output_, "\n\t\t\t%-16s",
DidName(tag_desc[i].tag_name));
Code_Label;
}
}
break;
#if (NREGARG > 0)
case Switch_on_typeAR:
Ar;
if (option & ALS)
{
int i;
for (i = 0; i < NTYPES; i++)
{
p_fprintf(current_output_, "\n\t\t\t%d: ", i);
Code_Label;
}
}
break;
#endif /* NREGARG */
case Ress:
VarOffset;
case Res:
Integer;
EnvDesc;
break;
case Continue_after_event:
case Continue_after_event_debug:
case Debug_exit:
case BI_ContDebug:
break;
case Puts_proc:
case Undefined:
Proc;
break;
default:
p_fprintf(current_output_, "Undefined opcode in print_am: %d", *(code - 1));
code = 0;
}
}
(void) ec_newline(current_output_); /* to flush if tty */
return code;
}