static void _print_label(vmcode **ptr) { char *instr; int inst; p_fprintf(current_output_,"%d(", (word) (*ptr) #ifndef PRINTAM & 0xfff #endif ); if (InvalidAddress(*ptr)) ec_outfs(current_output_, "BAD ADDRESS"); else { inst = Get_Int_Opcode(*ptr); if (inst < 0 || inst > NUMBER_OP) inst = Inst_Error; instr = inst_name[inst]; while (*instr != ' ') (void) ec_outfc(current_output_, *instr++); } (void) ec_outfc(current_output_, ')'); }
ppw(pword *pw) /* print prolog words */ { int arity = 1; pword *queue_head = (pword *) 0; pword *queue_tail = (pword *) 0; for (;;) { char region; int t = TagType(pw->tag); if (t < TFORWARD || t > TBUFFER) t = TUNKNOWN; if (TG_ORIG <= pw && pw < TG) region = 'g'; else if (SP <= pw && pw < SP_ORIG) region = 'l'; else if (B_ORIG <= pw && pw < B.args) region = 'c'; else if (TT <= (pword **) pw && (pword **) pw < TT_ORIG) region = 't'; else if (address_in_heap(&global_heap, (generic_ptr) pw)) region = 'h'; else region = '?'; p_fprintf(current_output_, "%c 0x%08x: 0x%08x 0x%08x %s ", region, pw, pw->val.all, pw->tag.all, tag_string[t-TUNKNOWN]); switch (t) { case TFORWARD: case TMETA: case TNAME: if (pw != pw->val.ptr) { ec_outfs(current_output_, "--->"); EnQueue_(pw->val.ptr, 1); } else { ec_outfs(current_output_, IsNamed(pw->tag.kernel) ? DidName(TagDid(pw->tag.kernel)) : "_"); } break; case TVAR_TAG: if (pw != pw->val.ptr) { ec_outfs(current_output_, "--->"); EnQueue_(pw->val.ptr, 1); } else ec_outfs(current_output_, "_"); break; case TLIST: EnQueue_(pw->val.ptr, 2); break; case TCOMP: if (pw->val.ptr) EnQueue_(pw->val.ptr, DidArity(pw->val.ptr->val.did)+1); break; case TSTRG: ec_outfs(current_output_, StringStart(pw->val)); break; case TSUSP: break; case TDE: break; case THANDLE: break; case TNIL: break; case TINT: p_fprintf(current_output_, "%d", pw->val.nint); break; case TDICT: ec_outfs(current_output_, DidName(pw->val.did)); if (DidArity(pw->val.did)) p_fprintf(current_output_, "/%d", DidArity(pw->val.did)); break; case TPTR: break; case TPROC: case TEND: case TVARNUM: case TGRS: case TGRL: case TEXTERN: case TBUFFER: break; case TDBL: p_fprintf(current_output_, "%f", Dbl(pw->val)); break; case TBIG: case TRAT: default: if (t >= 0 && t <= NTYPES) { (void) tag_desc[t].write(QUOTED, current_output_, pw->val, pw->tag); } break; } ec_newline(current_output_); if (--arity > 0) { pw++; continue; } ec_newline(current_output_); if (EmptyQueue()) break; DeQueue_(pw, arity); } Succeed_; }
/* pr(Name/Arity) prints on the current_output the properties of a predicate in all modules. */ static int p_pr(value v, type t) { pri *proc; dident wdid; dident module; int flags; int yes = 0; Get_Proc_Did(v, t, wdid); proc = DidPtr(wdid)->procedure; while (proc) { module = proc->module_def; if (!module #ifndef PRINTAM || (IsLocked(module) && !PriExported(proc)) #endif ) { proc = proc->nextproc; continue; } yes = 1; p_fprintf(log_output_, "in %s: ", DidName(module)); if (SystemProc(proc)) p_fprintf(log_output_, "system "); if (proc->flags & AUTOLOAD) (void) ec_outfs(log_output_, "autoload "); if (proc->flags & PROC_DYNAMIC) { (void) ec_outfs(log_output_, "dynamic "); } else { (void) ec_outfs(log_output_, "static "); } switch(proc->flags & CODETYPE) { case VMCODE: (void) ec_outfs(log_output_, "vmcode "); break; case FUNPTR: (void) ec_outfs(log_output_, "funptr "); break; default: (void) ec_outfs(log_output_, "code? "); break; } switch(proc->flags & ARGPASSING) { case ARGFIXEDWAM: (void) ec_outfs(log_output_, "argfixedwam "); break; case ARGFLEXWAM: (void) ec_outfs(log_output_, "argflexwam "); break; default: (void) ec_outfs(log_output_, "? "); break; } if (proc->flags & EXTERN) { (void) ec_outfs(log_output_, "external"); switch(proc->flags & UNIFTYPE) { case U_NONE: (void) ec_outfs(log_output_, "_u_none "); break; case U_SIMPLE: (void) ec_outfs(log_output_, "_u_simple "); break; case U_GROUND: (void) ec_outfs(log_output_, "_u_ground "); break; case U_UNIFY: /* equal to fresh */ (void) ec_outfs(log_output_, "_u_unify "); break; case U_GLOBAL: (void) ec_outfs(log_output_, "_u_global "); break; case U_DELAY: (void) ec_outfs(log_output_, "_u_delay "); break; default: (void) ec_outfs(log_output_, "_u_? "); break; } } else { (void) ec_outfs(log_output_, "prolog "); } flags = proc->flags; if (flags & TOOL) (void) ec_outfs(log_output_, "tool "); switch (PriScope(proc)) { case EXPORT: (void) ec_outfs(log_output_, "exported "); break; case LOCAL: (void) ec_outfs(log_output_, "local "); break; case IMPORT: (void) ec_outfs(log_output_, "imported "); break; case DEFAULT: (void) ec_outfs(log_output_, "default "); break; case QUALI: (void) ec_outfs(log_output_, "qualified "); break; } p_fprintf(log_output_, "%s ", DidName(proc->module_ref)); if (flags & DEBUG_DB) (void) ec_outfs(log_output_, "debugged "); if (flags & DEBUG_ST) (void) ec_outfs(log_output_, "start_tracing "); if (flags & DEBUG_TR) (void) ec_outfs(log_output_, "traceable "); else (void) ec_outfs(log_output_, "untraceable "); if (flags & DEBUG_SP) (void) ec_outfs(log_output_, "spied "); if (flags & DEBUG_SK) (void) ec_outfs(log_output_, "skipped "); if (!PriReferenced(proc)) (void) ec_outfs(log_output_, "non_referenced "); if (flags & CODE_DEFINED) (void) ec_outfs(log_output_, "code_defined "); proc = proc->nextproc; (void) ec_outfs(log_output_, "\n"); } if (yes) { Succeed_; } else { Fail_; } }