1/* BEGIN LICENSE BLOCK 2 * Version: CMPL 1.1 3 * 4 * The contents of this file are subject to the Cisco-style Mozilla Public 5 * License Version 1.1 (the "License"); you may not use this file except 6 * in compliance with the License. You may obtain a copy of the License 7 * at www.eclipse-clp.org/license. 8 * 9 * Software distributed under the License is distributed on an "AS IS" 10 * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 11 * the License for the specific language governing rights and limitations 12 * under the License. 13 * 14 * The Original Code is The ECLiPSe Constraint Logic Programming System. 15 * The Initial Developer of the Original Code is Cisco Systems, Inc. 16 * Portions created by the Initial Developer are 17 * Copyright (C) 1989-2006 Cisco Systems, Inc. All Rights Reserved. 18 * 19 * Contributor(s): 20 * 21 * END LICENSE BLOCK */ 22 23/* 24 * SEPIA C SOURCE MODULE 25 * 26 * VERSION $Id: emu_util.c,v 1.8 2015/04/04 23:09:42 jschimpf Exp $ 27 */ 28 29/* 30 * IDENTIFICATION emu_util.c 31 * 32 */ 33 34#include "config.h" 35 36#ifdef AS_EMU 37#include <sys/time.h> 38#include <sys/resource.h> 39#endif 40 41#include "sepia.h" 42#include "types.h" 43#include "debug.h" 44#include "embed.h" 45#include "error.h" 46#include "mem.h" 47#include "opcode.h" 48#include "dict.h" 49#include "module.h" 50#include "emu_export.h" 51#include "ec_io.h" 52 53extern int p_exit(value v, type t); /* to stop in a clean way */ 54extern int ec_init_postponed(void); 55 56fail_data_t fail_trace_[MAX_FAILTRACE]; 57 58#ifdef AS_EMU 59 60pword *bmax_; /* to define the Gc and overflow checks for the assembler */ 61pword *spmax_; /* not for overflow checks, just to know if an address 62 * is in the local stack 63 */ 64 65#endif /* AS_EMU */ 66 67/* fraction of global_trail size to take as default gc-interval */ 68#define GC_INTERVAL_FRACTION 64 69 70/* minimal default gc-interval */ 71#define MIN_GC_INTERVAL (64*1024) 72 73/* 74 * allocate_stacks() 75 * 76 * allocate Prolog stacks with the given sizes and initialize 77 * the pointers to their borders 78 */ 79 80 81allocate_stacks(void) 82{ 83 extern void alloc_stack_pairs(int nstacks, char **names, uword *bytes, struct stack_struct **descr); 84 static char *names[4] = { "global","trail","control","local" }; 85 uword sizes[4]; 86 struct stack_struct *stacks[4]; 87 88 stacks[0] = &g_emu_.global_trail[0]; 89 stacks[1] = &g_emu_.global_trail[1]; 90 stacks[2] = &g_emu_.control_local[0]; 91 stacks[3] = &g_emu_.control_local[1]; 92 93 sizes[0] = ec_options.globalsize; 94 sizes[1] = 0; 95 sizes[2] = ec_options.localsize; 96 sizes[3] = 0; 97 98 TG_SEG = 99 ( ec_options.globalsize/GC_INTERVAL_FRACTION > MIN_GC_INTERVAL ? 100 ec_options.globalsize/GC_INTERVAL_FRACTION : MIN_GC_INTERVAL ) /sizeof(pword); 101 102 alloc_stack_pairs( 4, names, sizes, stacks); 103 104#ifdef AS_EMU 105 106 /* differences with the assembler emulator: 107 * - g_emu_.sporigin is set in main() to point into the C stack 108 * - B is checked against bmax_ in overflow checks (there is always 109 * room left for one frame of the biggest size (invocation frame)) 110 */ 111 112 bmax_ = (pword *) ((char *) g_emu_.blimit - NARGREGS * sizeof(pword) 113 - sizeof(struct invocation_frame)); 114 115#if defined(RLIMIT_STACK) 116 { 117 struct rlimit rlp; 118 getrlimit(RLIMIT_STACK, &rlp); 119 120 spmax_ = g_emu_.sporigin - rlp.rlim_cur/sizeof(pword); 121 } 122#else /* don't know how to find the stack size in SYS_V */ 123 spmax_ = g_emu_.sporigin - 0x1000000; /* 16MB */ 124#endif 125 126#endif /* AS_EMU */ 127 128} 129 130/* 131 * p_print_stacks() 132 * prints out the memory layout of the stacks 133 */ 134int 135p_print_stacks(void) 136{ 137 struct stack_struct *stacks[4]; 138 struct stack_struct *s; 139 int i; 140 141 stacks[0] = &g_emu_.global_trail[0]; 142 stacks[1] = &g_emu_.global_trail[1]; 143 stacks[2] = &g_emu_.control_local[0]; 144 stacks[3] = &g_emu_.control_local[1]; 145 146 p_fprintf(current_err_,"Name\t\tStart\t\tEnd\t\tPeak\n"); 147 for(i=0 ; i<4 ; i++) 148 { 149 s = stacks[i]; 150 p_fprintf(current_err_,"%s\t\t0x%08x\t0x%08x\t0x%08x\n", 151 s->name,s->start,s->end,s->peak); 152 } 153 ec_flush(current_err_); 154 Succeed_; 155} 156 157 158/* 159 * Initialize global variables 160 * Caution: pushes stuff on global stack 161 */ 162void 163ec_init_globvars(void) 164{ 165 pword *p; 166 int i; 167 168 g_emu_.global_variable = TG; 169 Push_Struct_Frame(in_dict("gv",GLOBAL_VARS_NO)); 170 for (i = 0; i < GLOBAL_VARS_NO; i++) 171 { 172 Make_Integer(&GLOBVAR[i], 0); 173 } 174#ifdef DFID 175 p = TG; /* DFID vars */ 176 TG += 4; 177 for (i = 0; i < 4; i++) { 178 GLOBVAR[i+1].tag.kernel = TREF; 179 GLOBVAR[i+1].val.ptr = p + i; 180 p[i].tag.kernel = TINT; 181 } 182 p[0].val.nint = p[3].val.nint = 0; 183 p[1].val.nint = p[2].val.nint = 1000000; 184#endif 185} 186 187 188/* 189 * (re)initialize the abstract machine status on booting or after reset 190 * We need to initialize those registers that might not be initialised 191 * on emulator entry (save_vm_status), or that need to have a sensible 192 * previous value. 193 */ 194 195void 196emu_init(int flags, int vm_options) 197{ 198 int i; 199#ifdef lint 200 value v1; 201 uword *find_word(); 202 203 v1.all = 0; 204 (void) schedule_cut_fail_action(emu_init, v1, tint); 205 (void) lastpp(0); 206 (void) find_word((uword) 0); 207 (void) check_global(); 208#endif /* lint */ 209 210 if (flags & INIT_PRIVATE) 211 allocate_stacks(); 212 213 /* the stack pointers */ 214 TG = GCTG = GB = (pword *) g_emu_.global_trail[0].start; 215 TT = (pword **) g_emu_.global_trail[1].start; 216 if (!trim_global_trail(TG_SEG)) /* sets TG_LIM and TT_LIM */ 217 ec_panic(MEMORY_P, "emu_init()"); 218 219 B.args = PB = PPB = (pword *) g_emu_.control_local[0].start; 220#ifndef AS_EMU 221 E = SP = EB = (pword *) g_emu_.control_local[1].start; 222#endif 223 if (!trim_control_local()) /* sets b_limit and sp_limit */ 224 ec_panic(MEMORY_P, "emu_init()"); 225 226 /* some other registers */ 227 DE = MU = LD = LCA = OCB = TCS = TO = TG_SL = TG_SLS = (pword *) 0; 228 FO = PO = (char *) 0; 229 PP = (vmcode *) 0; 230 WP = LOAD = NTRY = 0; 231 232 /* Push a witness that is older than any choicepoint's witness. 233 * It must be the first pword on the global stack!!! 234 * (this is assumed by the Init_Stamp() macro) 235 */ 236 Push_Witness; /* a stamp older than any other */ 237 238 Make_Struct(&TAGGED_WL, (pword*)0); /* WL */ 239 Make_Ref(&WP_STAMP, (pword*)0); /* Make_Stamp(&WP_STAMP) */ 240 Make_Var(&POSTED); /* difference list of posted goals */ 241 POSTED_LAST = POSTED; 242 PARSENV = NULL; 243 Set_Bip_Error(0); 244 245 for(i = 0; i < NARGREGS; i++) 246 { 247 A[i].val.all = 0; 248 A[i].tag.kernel = TEND; 249 } 250 251 g_emu_.nesting_level = 0; 252 g_emu_.it_buf = (jmp_buf *) NULL; /* overwritten in emulc() */ 253 VM_FLAGS = vm_options; 254 EVENT_FLAGS = 0; 255 256 ec_init_dynamic_event_queue(); 257 258 Make_Integer(&TAGGED_TD, 0); 259 FTRACE = fail_trace_; 260 FCULPRIT = -1; 261 DBG_PRI = (pri *) 0; 262 263 if (!ec_options.parallel_worker) 264 LEAF = 0; 265 266 ec_init_globvars(); 267 ec_init_postponed(); 268 269 TracerInit; 270} 271 272 273/* 274 * Finalize the engine 275 */ 276 277void 278ec_emu_fini() 279{ 280 extern void dealloc_stack_pairs(struct stack_struct *, struct stack_struct *); 281 dealloc_stack_pairs(g_emu_.global_trail, g_emu_.control_local); 282} 283 284 285static int 286_equal_value(pword *pw1, pword *pw2) 287{ 288 return pw1 == pw2; 289} 290 291static int 292_equal_handle(pword *pw1, pword *pw2) 293{ 294 return 295 ExternalClass(pw1) == ExternalClass(pw2) /* same type */ 296 && 297 ( 298 ExternalData(pw1) == ExternalData(pw2) /* same value */ 299 || 300 ExternalClass(pw1)->equal /* has comp fct */ 301 && 302 ExternalClass(pw1)->equal(ExternalData(pw1), ExternalData(pw2)) 303 ); 304} 305 306static int 307_compare_handle(value v1, value v2) 308{ 309 /* TODO: comparing the addresses of class descriptors is not ideal, 310 * as they may differ between executables. Better compare some ID. 311 */ 312 int diff = (int)(ExternalClass(v1.ptr) - ExternalClass(v2.ptr)); 313 if (!diff) 314 diff = (int)(ExternalData(v1.ptr) - ExternalData(v2.ptr)); 315 return diff; 316} 317 318static int 319_compare_dummy(value v1, value v2) 320{ 321 return -1; 322} 323 324static int 325_arith_compare_dummy(value v1, value v2, int *res) 326{ 327 *res = -1; 328 return PERROR; 329} 330 331/*ARGSUSED*/ 332static int 333_compare_pointers(value v1, value v2) 334{ 335 return v1.ptr - v2.ptr; 336} 337 338/*ARGSUSED*/ 339static int 340_lex_error(char* s, pword* result, int base) 341{ 342 return BAD_NUMERIC_CONSTANT; 343} 344 345/* 346 * Bips coded in the emulator 347 * 348 * to add a new one: add a new call to built_in after the last with flags 349 * BIPNO, add the case in the emulator in the instruction Escape and 350 * the BIopcode in opcode.h. Also add the name in names.h 351 */ 352 353void 354bip_emu_init(int flags) 355{ 356 pri *proc; 357 int i; 358 359 if (flags & INIT_PRIVATE) 360 { 361 int o = 1; 362 363 for (i=0; i <= NTYPES; i++) 364 { 365 tag_desc[i].equal = _equal_value; 366 tag_desc[i].compare = _compare_dummy; 367 tag_desc[i].arith_compare = _arith_compare_dummy; 368 tag_desc[i].from_string = _lex_error; 369 tag_desc[i].string_size = 0; 370 tag_desc[i].to_string = 0; 371 tag_desc[i].order = 0; 372 } 373 374 tag_desc[THANDLE].equal = _equal_handle; 375 tag_desc[THANDLE].compare = _compare_handle; 376 tag_desc[TSUSP].compare = _compare_pointers; 377 378 tag_desc[TIVL].order = o++; /* this determines the type order in @> etc */ 379 tag_desc[TDBL].order = o++; 380 tag_desc[TRAT].order = o++; 381 tag_desc[TINT].order = 382 tag_desc[TBIG].order = o++; 383 tag_desc[TSTRG].order = o++; 384 tag_desc[TNIL].order = 385 tag_desc[TDICT].order = o++; 386 tag_desc[TLIST].order = 387 tag_desc[TCOMP].order = o++; 388 for (i=0; i <= NTYPES; i++) 389 { 390 if (!tag_desc[i].order) 391 tag_desc[i].order = o++; 392 } 393 394 } 395} 396 397 398/* 399 * Initialize the read-only table opaddr[] 400 * It holds the addresses of abstract instructions in the emulator 401 * This is only needed for threaded code versions 402 * With gcc we use a different scheme and ignore POSTPRO. 403 */ 404 405#if defined(THREADED) && !defined(POSTPRO) 406vmcode op_addr[NUMBER_OP]; 407#endif 408 409void 410opaddr_init(void) 411{ 412#ifdef THREADED 413#if defined(__GNUC__) || defined(_WIN32) 414 op_addr[0] = 0; 415 (void) ec_emulate(); /* will init op_addr[] */ 416 if (op_addr[Retry] == op_addr[Retry_inline] 417 || op_addr[Trust] == op_addr[Trust_inline]) 418 { 419 ec_panic("Instructions not distinguishable - C compiler too clever", "opaddr_init()"); 420 } 421#else 422#ifdef POSTPRO 423#ifdef mc68000 424 int i, j; 425 426 for (i=0,j=0; i<NUMBER_OP; i++) 427 { 428 /* 429 * For compilers that generate switch tables with relative offsets, 430 * we have to compute the op_addr[] array from this switch table 431 * (otherwise the switch table can be used directly as op_addr[]) 432 * If the -J option is used in cc, opswitch_table[] has to be long int! 433 */ 434 extern short opswitch_table[]; /* opt_sun3.sh inserts this label */ 435 436 op_addr[i] = (long) opswitch_table[i] + (long) opswitch_table; 437 } 438#endif 439#endif 440#endif 441#endif /*THREADED*/ 442} 443 444 445#if defined(PRINTAM) || defined(LASTPP) 446 447/* 448 * lastpp(n) - a tool for debugging the emulator 449 * prints the n most recently executed abstract instructions 450 * can be called from dbx etc. 451 */ 452 453lastpp(int n) 454{ 455 extern vmcode *ec_backtrace[]; 456 extern int bt_index, bt_max; 457 extern vmcode *print_am(register vmcode *code, vmcode **label, int *res, int option); 458 int i; 459 vmcode *dummy_l = NULL; 460 int dummy_r; 461 462 if (n >= bt_max) i = bt_index; 463 else i = (bt_index + bt_max - n) % bt_max; 464 do { 465 (void) print_am(ec_backtrace[i], &dummy_l, &dummy_r, 2 /*PROCLAB*/); 466 i = (i+1) % bt_max; 467 } while (i != bt_index); 468} 469 470#endif /* PRINTAM */ 471 472#if defined(PRINTAM) 473 474uword * 475find_word(uword w) /* scan Prolog data areas for a particular uword */ 476{ 477 uword *p; 478 for(p = g_emu_.global_trail[0].start; p < g_emu_.global_trail[0].end; p++) 479 if (*p == w) p_fprintf(current_err_, "global 0x%x\n", p); 480 for(p = g_emu_.global_trail[1].end; p < g_emu_.global_trail[1].start; p++) 481 if (*p == w) p_fprintf(current_err_, "trail 0x%x\n", p); 482 for(p = g_emu_.control_local[0].start; p < g_emu_.control_local[0].end; p++) 483 if (*p == w) p_fprintf(current_err_, "control 0x%x\n", p); 484 for(p = g_emu_.control_local[1].end; p < g_emu_.control_local[1].start; p++) 485 if (*p == w) p_fprintf(current_err_, "local 0x%x\n", p); 486 for(p = (uword *) &g_emu_.emu_args[0]; 487 p < (uword *) &g_emu_.emu_args[NARGREGS]; p++) 488 if (*p == w) p_fprintf(current_err_, "arg 0x%x\n", p); 489 ec_flush(current_err_); 490} 491 492void 493print_chp(pword *b, int n) /* print the n topmost choicepoints (0 = all) */ 494{ 495 extern vmcode par_fail_code_[]; 496 control_ptr fp; 497 fp.args = b ? b : B.args; 498 do 499 { 500 p_fprintf(current_err_, "0x%x --- ", fp.args); 501 if (BPrev(fp.args) == (pword *) (fp.top - 1)) 502 { 503 p_fprintf(current_err_, "if-then-else:\n"); 504 } 505 else 506 { 507 if (IsInterruptFrame(BTop(fp.args))) 508 { 509 p_fprintf(current_err_, "interrupt:\n"); 510 n=1; 511 } 512 else if (IsRecursionFrame(BTop(fp.args))) 513 { 514 p_fprintf(current_err_, "invocation:\n"); 515 n=1; 516 p_fprintf(current_err_, 517 " ppb=0x%x alt=%d node={0x%x,0x%x,0x%x}\n", 518 BPar(fp.args)->ppb, BPar(fp.args)->alt, 519 BPar(fp.args)->node.site, BPar(fp.args)->node.edge, 520 BPar(fp.args)->node.knot); 521 } 522 else if (IsExceptionFrame(BTop(fp.args))) 523 p_fprintf(current_err_, "exception:\n"); 524 else if (IsCatchFrame(BTop(fp.args))) 525 p_fprintf(current_err_, "catch:\n"); 526 else if (IsGcFrame(BTop(fp.args))) 527 p_fprintf(current_err_, "gc-dummy:\n"); 528 else if (IsRetryMeInlineFrame(BTop(fp.args)) 529 || IsTrustMeInlineFrame(BTop(fp.args)) 530 || IsRetryInlineFrame(BTop(fp.args)) 531 || IsTrustInlineFrame(BTop(fp.args))) 532 p_fprintf(current_err_, "inline(0x%lx):\n", BBp(fp.args)); 533 else if (IsUnpubParFrame(BTop(fp.args))) 534 { 535 p_fprintf(current_err_, "parallel unpublished:\n"); 536 p_fprintf(current_err_, 537 " ppb=0x%x alt=%d node={0x%x,0x%x,0x%x}\n", 538 BPar(fp.args)->ppb, BPar(fp.args)->alt, 539 BPar(fp.args)->node.site, BPar(fp.args)->node.edge, 540 BPar(fp.args)->node.knot); 541 } 542 else if (IsPubParFrame(BTop(fp.args))) 543 { 544 p_fprintf(current_err_, "parallel published:\n"); 545 p_fprintf(current_err_, 546 " ppb=0x%x alt=%d node={0x%x,0x%x,0x%x}\n", 547 BPar(fp.args)->ppb, BPar(fp.args)->alt, 548 BPar(fp.args)->node.site, BPar(fp.args)->node.edge, 549 BPar(fp.args)->node.knot); 550 } 551 else if (BBp(fp.args) == par_fail_code_) 552 { 553 p_fprintf(current_err_, "parallel dead:\n"); 554 p_fprintf(current_err_, 555 " ppb=0x%x alt=%d node={0x%x,0x%x,0x%x}\n", 556 BPar(fp.args)->ppb, BPar(fp.args)->alt, 557 BPar(fp.args)->node.site, BPar(fp.args)->node.edge, 558 BPar(fp.args)->node.knot); 559 } 560 else 561 { 562 p_fprintf(current_err_, "sequential(0x%lx):\n", BBp(fp.args)); 563 } 564 565 p_fprintf(current_err_, 566 " sp=0x%x tg=0x%x tt=0x%x e=0x%x ld=0x%x\n", 567 BChp(fp.args)->sp, BChp(fp.args)->tg, 568 BChp(fp.args)->tt, BChp(fp.args)->e, 569 BChp(fp.args)->ld); 570 } 571 fp.args = BPrev(fp.args); 572 } 573 while (--n); 574 ec_flush(current_err_); 575} 576 577 578static _print_code_address(stream_id nst, vmcode *code) 579{ 580 extern pri *ec_code_procedure(vmcode *code); 581 pri *pd = ec_code_procedure(code); 582 if (pd) { 583 p_fprintf(nst,"%s/%d+%d", 584 DidName(PriDid(pd)), DidArity(PriDid(pd)), code - PriCode(pd)); 585 } else { 586 p_fprintf(nst,"<proc unknown>"); 587 } 588} 589 590 591/* 592 * Print all choicepoints and all environment chains. 593 * If execution is currently inside emulator, pass e and sp as parameters! 594 */ 595 596void 597print_control(pword *e, pword *sp) 598{ 599 control_ptr fp; 600 pword *b, *env; 601 int after_call; 602 char *kind; 603 604 if (!e) e = E; /* use the exported values, if none given */ 605 if (!sp) sp = SP; 606 607 p_fprintf(current_err_, "current\n"); 608 p_fprintf(current_err_, " rtrnto 0x%lx ?-> 0x%lx ", SP, *(vmcode**)SP); 609 _print_code_address(current_err_, *(vmcode**)SP); 610 ec_newline(current_err_); 611 for(env = E; env < SP_ORIG; env = *(pword**)env) 612 { 613 vmcode **cpp = ((vmcode**)env)+1; 614 p_fprintf(current_err_, " exitto 0x%lx -> 0x%lx ", cpp, *cpp); 615 _print_code_address(current_err_, *cpp); 616 ec_newline(current_err_); 617 } 618 619 for(b=B.args;;b=fp.args) 620 { 621 ec_newline(current_err_); 622 fp.args = BPrev(b); 623 624 if (IsInterruptFrame(BTop(b)) || IsRecursionFrame(BTop(b))) 625 { 626 p_fprintf(current_err_, "invoc"); 627 break; 628 } 629 else if (IsCatchFrame(BTop(b))) 630 { 631 kind = "catch"; after_call = 1; 632 } 633 else if (IsExceptionFrame(BTop(b))) 634 { 635 kind = "exception"; after_call = 0; 636 } 637 else if (IsRetryMeInlineFrame(BTop(b))) 638 { 639 kind = "inline"; after_call = 0; 640 } 641 else if (IsTrustMeInlineFrame(BTop(b))) 642 { 643 kind = "inline"; after_call = 0; 644 } 645 else if (IsRetryInlineFrame(BTop(b))) 646 { 647 kind = "inline"; after_call = 0; 648 } 649 else if (IsTrustInlineFrame(BTop(b))) 650 { 651 kind = "inline"; after_call = 0; 652 } 653 else /* if (IsChoicePoint(BTop(b))) */ 654 { 655 kind = "clause"; after_call = 1; 656 } 657 658 p_fprintf(current_err_, "%s 0x%lx -> 0x%lx ", kind, b, BBp(b)); 659 _print_code_address(current_err_, BBp(b)); 660 ec_newline(current_err_); 661 662 if (after_call) 663 { 664 p_fprintf(current_err_, " rtrnto 0x%lx -> 0x%lx ", SP, *(vmcode**)SP); 665 _print_code_address(current_err_, *(vmcode**)SP); 666 ec_newline(current_err_); 667 } 668 for(env = fp.chp->e; env < SP_ORIG; env = *(pword**)env) 669 { 670 vmcode **cpp = ((vmcode**)env)+1; 671 p_fprintf(current_err_, " exitto 0x%lx -> 0x%lx ", cpp, *cpp); 672 _print_code_address(current_err_, *cpp); 673 ec_newline(current_err_); 674 } 675 } 676 ec_newline(current_err_); 677} 678 679 680#endif /* PRINTAM */ 681