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: printam.c,v 1.10 2013/04/29 01:02:11 jschimpf Exp $ 27 */ 28 29/* 30 * SEPIA abstract code printing 31 * This is a function that prints an abstract instruction in a readable 32 * form . It returns the pointer to the start of the next instruction, 33 * so when it is used to print the whole code without executing it, 34 * a sequence 35 * ptr = print_am(ptr); 36 * is to be used. 37 */ 38 39#include "config.h" 40 41#ifndef NOALS /* otherwise everything is omitted */ 42 43#include "names.h" /* so that the names array is defined */ 44#include "sepia.h" 45#include "types.h" 46#include "embed.h" 47#include "error.h" 48#include "mem.h" 49#include "opcode.h" 50#include "ec_io.h" 51#include "dict.h" 52#include "emu_export.h" 53#include "database.h" 54#include "gencode.h" 55#include "module.h" 56#include "debug.h" 57 58extern vmcode fail_code_[]; 59void print_port(stream_id nst, int port); 60static void _print_label(vmcode **ptr); 61static vmcode *_print_init_mask(vmcode *code, int name); 62static void _print_edesc(uword); 63 64/* this one should also check >= brk(0) */ 65#define InvalidAddress(ptr) ((ptr) == NULL || (uword) (ptr) & 0x3) 66#define H_did(start) *((start) - 1) 67#define Arg(addr) ((pword *) addr - g_emu_.emu_args) 68#define Atom {p_fprintf(current_output_,"%s ", DidName(*code)); code++;} 69#define VarOffset p_fprintf(current_output_,"%d ", (int)(*code++)/(word)sizeof(pword)) 70#define Integer p_fprintf(current_output_,"%d ", (int)(*code++)) 71#define ArgDesc p_fprintf(current_output_,"<%x> ", (int)(*code++)) 72#define Float p_fprintf(current_output_,"%f ", * (float *) code++) 73#define String \ 74 { value v;\ 75 v.str = (char *) *code++;\ 76 (void) ec_outf(current_output_, StringStart(v), (int) StringLength(v));\ 77 } 78#define Structure \ 79 {p_fprintf(current_output_,"%s/", DidName(*code));\ 80 p_fprintf(current_output_, "%d ", DidArity(*code)); code++;} 81#define Code_Label \ 82 if (*(vmcode **) code == FailCode) \ 83 (void) ec_outfs(current_output_,"Fail "); \ 84 else \ 85 _print_label((vmcode **) code); \ 86 code++; 87#define Save_Label \ 88 if (*(vmcode **) code == FailCode) \ 89 (void) ec_outfs(current_output_,"Fail "); \ 90 else { \ 91 *label = (vmcode *)(*code); \ 92 _print_label((vmcode **) code);} \ 93 code++; 94#define Print_Label(p) \ 95 if (*(vmcode**)(p) == FailCode) \ 96 (void) ec_outfs(current_output_,"Fail "); \ 97 else \ 98 _print_label((vmcode**)(p)); 99#ifdef PRINTAM 100#define Consttag \ 101 if (TagTypeC((word)(*code)) < 0 || TagTypeC((word)(*code)) > NTYPES) \ 102 p_fprintf(current_output_,"<illegal tag> <%x>", (int)(*code)); \ 103 else p_fprintf(current_output_,"%s <%x> ", \ 104 DidName(tag_desc[TagTypeC((word)(*code))].tag_name), (int)(*code)); \ 105 code++; 106#else 107#define Consttag \ 108 if (TagTypeC((word)(*code)) < 0 || TagTypeC((word)(*code)) > NTYPES) \ 109 p_fprintf(current_output_,"<illegal tag> "); \ 110 else p_fprintf(current_output_,"%s ", \ 111 DidName(tag_desc[TagTypeC((word)(*code))].tag_name)); \ 112 code++; 113#endif 114#define Const p_fprintf(current_output_,"const <%x> ", (int)(*code++)) 115#define NamedVar {if (IsNamed(*code)) \ 116 p_fprintf(current_output_,"%s ",\ 117 DidName(TagDid(*code)));\ 118 else\ 119 p_fprintf(current_output_,"_ ");\ 120 code++;} 121#define RelLabel p_fprintf(current_output_,"%d ", (int)(*code++)) 122#define SaveRelLabel RelLabel 123#define Am p_fprintf(current_output_,"A%d ", Arg(*code++)) 124#ifdef Ar 125#undef Ar 126#endif 127#define Ar (void) ec_outfs(current_output_,"rA1 ") 128#define Temp p_fprintf(current_output_,"T%d ", (*code++)/(word)sizeof(pword)) 129#define TempR (void) ec_outfs(current_output_,"rT ") 130#define Perm p_fprintf(current_output_,"Y%d ", (*code++)/(word)sizeof(pword)) 131#define Nl (void) ec_newline(current_output_); 132#define Else (void) ec_outfs(current_output_,"Else "); 133#ifdef PRINTAM 134#define Addr p_fprintf(current_output_, "0x%x ", *code++); 135#else 136#define Addr p_fprintf(current_output_, "0x%x ", *code++ & 0xfff); 137#endif 138#define Proc \ 139 {did1 = PriDid((pri *) *code);\ 140 if (PriScope((pri *) *code) == QUALI)\ 141 p_fprintf(current_output_,"%s:", DidName(PriHomeModule((pri *) *code))); \ 142 p_fprintf(current_output_,"%s/%d ", DidName(did1), DidArity(did1));\ 143 code++; } 144#define EsuName \ 145 {p_fprintf(current_output_,"%s/", DidName(((pri *) *code)->did));\ 146 p_fprintf(current_output_,"%d ",DidArity(((pri *)*code)->did));\ 147 code++;} 148 149 150#define ExtName EsuName 151#define ExtCallName EsuName 152 153#define Port print_port(current_output_, *(word*)code++) 154 155#define Atom_Table2 \ 156 { \ 157 uword *ptr = (uword *) *code++; \ 158 uword *end; \ 159 \ 160 end = (uword *) ((pword *) ptr + *code++); \ 161 do \ 162 { \ 163 p_fprintf(current_output_, \ 164 "\n\t\t\t%s:\t", \ 165 DidName((dident)*ptr)); \ 166 ptr++; \ 167 _print_label((vmcode **) ptr); \ 168 ptr++; \ 169 } while (ptr < end); \ 170 (void) ec_outfs(current_output_, "\n\t\t\tdefault:");\ 171 } 172 173#define Integer_Range_Table \ 174 { \ 175 uword *ptr = (uword *) *code++; \ 176 uword *end; \ 177 \ 178 p_fprintf(current_output_, " %d", *code); \ 179 p_fprintf(current_output_, "\n\t\t\t< %d:\t", (int) *ptr);\ 180 _print_label((vmcode **) (ptr + 1)); \ 181 p_fprintf(current_output_, "\n\t\t\t> %d:\t", (int) *(ptr+2));\ 182 _print_label((vmcode **) (ptr + 3)); \ 183 ptr += 4; \ 184 end = (uword *) ((pword *) ptr + *code++); \ 185 while (ptr < end) \ 186 { \ 187 p_fprintf(current_output_, \ 188 "\n\t\t\t%d:\t", \ 189 (int) (*ptr)); \ 190 ptr++; \ 191 Print_Label(ptr); \ 192 ptr++; \ 193 } \ 194 (void) ec_outfs(current_output_, "\n\t\t\telse:\t");\ 195 Code_Label \ 196 (void) ec_outfs(current_output_, "\n\t\t\tdefault:");\ 197 Code_Label \ 198 } 199 200#define Integer_Table2 \ 201 { \ 202 uword *ptr = (uword *) *code++; \ 203 uword *end; \ 204 \ 205 end = (uword *) ((pword *) ptr + *code++); \ 206 do \ 207 { \ 208 p_fprintf(current_output_, \ 209 "\n\t\t\t%d:\t", \ 210 (int) (*ptr)); \ 211 ptr++; \ 212 _print_label((vmcode **) ptr); \ 213 ptr++; \ 214 } while (ptr < end); \ 215 (void) ec_outfs(current_output_, "\n\t\t\tdefault:");\ 216 } 217 218#define Functor_Table2 \ 219 { \ 220 uword *ptr = (uword *) *code++; \ 221 uword *end; \ 222 \ 223 end = (uword *) ((pword *) ptr + *code++); \ 224 do \ 225 { \ 226 p_fprintf(current_output_, \ 227 "\n\t\t\t%s/%d:\t", \ 228 DidName((dident) *ptr), \ 229 DidArity((dident) *ptr)); \ 230 ptr++; \ 231 _print_label((vmcode **) ptr); \ 232 ptr++; \ 233 } while (ptr < end); \ 234 (void) ec_outfs(current_output_, "\n\t\t\tdefault:");\ 235 } 236 237#define EnvDesc _print_edesc(*code++); 238 239#define PortName(Port) ec_debug_ports[(Port) & PORT_MASK] 240 241static char *ec_debug_ports[] = 242{ 243 " NOPORT ", 244 " CALL ", 245 " EXIT ", 246 "*EXIT ", 247 " REDO ", 248 " FAIL ", 249 " RESUME ", 250 " LEAVE ", 251 " DELAY ", 252 " NEXT ", 253 " UNIFY ", 254 " SPYTERM ", 255 " MODIFY ", 256 " ELSE ", 257 " ???? ", 258 " ???? ", 259 " OTHER " 260}; 261 262#define ALS 1 /* whole procedure being listed, not just one instr */ 263#define PROCLAB 2 /* print a symbolic address with each instruction */ 264 265vmcode * 266print_am(register vmcode *code, 267 vmcode **label, 268 int *res, 269 int option) /* ALS|PROCLAB */ 270{ 271 dident did1; 272 int inst; 273 274 if (*label == code) 275 *label = NULL; /* the label is about to being printed */ 276 277 if (InvalidAddress(code)) 278 inst = Inst_Error; 279 else 280 inst = Get_Int_Opcode(code++); 281 282 if (inst < 0 || inst > NUMBER_OP) 283 { 284 p_fprintf(current_output_, "Undefined opcode in print_am: %d", 285 inst); 286 code = 0; 287 *res = PFAIL; 288 } 289 if (inst == Code_end) { 290 *res = PSUCCEED; 291 return 0; 292 } 293 else if (inst == Comment) 294 return (vmcode *) code + (*code + 1); 295 else 296 { 297#ifdef PRINTAM 298 if (option & PROCLAB) /* try to print the location */ 299 { 300 extern pri *ec_code_procedure(vmcode *code); 301 pri *pd = ec_code_procedure(code-1); 302 if (pd) 303 p_fprintf(current_output_,"%s/%d+%d:\n", 304 DidName(PriDid(pd)), DidArity(PriDid(pd)), 305 code - PriCode(pd) - 1); 306 } 307#endif 308 p_fprintf(current_output_, "\t%s\t", inst_name[inst]); 309 switch (inst) 310 311 { 312 case Failure: 313 case Nop: 314 case Clause: 315 break; 316 317 case Read_void: 318 case Read_variable: 319 case Read_reference: 320 case Read_nil: 321 case Read_test_var: 322 case Write_variable: 323 case Write_void: 324 case Write_nil: 325 case Write_list: 326 case Write_first_list: 327 case Match_meta: 328 case Match_last_meta: 329 case First: 330 case Push_void: 331 case Push_variable: 332 case Push_nil: 333 case Push_list: 334 case Puts_variable: 335 case Puts_list: 336 case Puts_nil: 337 case Occur_check_next: 338 case Dfid_test: 339#if (NREGTMP > 0) 340 case FirstTR: 341#endif /* NREGTMP */ 342 case Inst_Error: 343 case Continue_after_exception: 344 case Refail: 345 break; 346 347 case Write_named_void: 348 case Write_named_variable: 349 case Push_self_reference: 350 case Write_meta: 351 NamedVar; 352 break; 353 354 case CutAM: 355 case MoveAM: 356 case Get_nilAM: 357 case Out_get_nilAM: 358 case In_get_nilAM: 359 case Read_variableAM: 360 case Read_referenceAM: 361 case Read_valueAM: 362 case Read_matched_valueAM: 363 case Write_valueAM: 364 case Write_local_valueAM: 365 case Put_nilAM: 366 case Out_get_listAM: 367 case Get_list_argumentsAM: 368 case Get_structure_argumentsAM: 369 case Write_variableAM: 370 case Put_variableAM: 371 case Put_global_variableAM: 372 case Put_listAM: 373 case Push_variableAM: 374 case Push_valueAM: 375 case Push_local_valueAM: 376 case Puts_valueAM: 377 case SavecutAM: 378 case BI_Exit: 379 case BI_SetBipError: 380 case BI_GetBipError: 381 case BI_Free: 382 case BI_Var: 383 case BI_NonVar: 384 case BI_Atom: 385 case BI_Integer: 386 case BI_Float: 387 case BI_Breal: 388 case BI_Real: 389 case BI_Rational: 390 case BI_String: 391 case BI_Number: 392 case BI_Atomic: 393 case BI_Compound: 394 case BI_Meta: 395 case BI_IsSuspension: 396 case BI_IsHandle: 397 case BI_IsEvent: 398 case BI_IsList: 399 case BI_Bignum: 400 case BI_Callable: 401 Am; 402 break; 403 404 case Write_named_variableAM: 405 case Put_named_variableAM: 406 Am; 407 NamedVar; 408 break; 409 410 case Put_named_variableAML: 411 Am; 412 Perm; 413 NamedVar; 414 break; 415 416 case Put_referenceAM: 417 Am; 418 case Puts_reference: 419 VarOffset; 420 NamedVar; 421 break; 422 423 case Put_referenceAML: 424 Am; 425 case Puts_referenceL: 426 Perm; 427 VarOffset; 428 NamedVar; 429 break; 430 431 case Move3AMAM: 432 Am; 433 /* fall through */ 434 case ShiftAMAMAMAMAM: 435 Am; 436 /* fall through */ 437 case ShiftAMAMAMAM: 438 case Move2AMAM: 439 Am; 440 /* fall through */ 441 442 case ShiftAMAMAM: 443 case RotAMAMAM: 444 case BI_NotIdentList: 445 case BI_Compare: 446 case BI_Qualify: 447 Am; 448 /* fall through */ 449 450 case BI_Identical: 451 case BI_NotIdentical: 452 case BI_Inequality: 453 case BI_ListEnd: 454 case SwapAMAM: 455 case Read_variable2AM: 456 case Write_variable2AM: 457 case Write_local_value2AM: 458 case Push_local_value2AM: 459 case Put_variable2AM: 460 Am; 461 Am; 462 break; 463 464 case BI_MakeSuspension: 465 Am; 466 /* fall through */ 467 468 case BI_Add: 469 case BI_Sub: 470 case BI_Mul: 471 case BI_Quot: 472 case BI_Div: 473 case BI_Rem: 474 case BI_FloorDiv: 475 case BI_FloorRem: 476 case BI_And: 477 case BI_Or: 478 case BI_Xor: 479 case BI_Lt: 480 case BI_Le: 481 case BI_Gt: 482 case BI_Ge: 483 case BI_Eq: 484 case BI_Ne: 485 case BI_Arg: 486 Am; 487 /* fall through */ 488 489 case BI_Minus: 490 case BI_Bitnot: 491 case BI_CutToStamp: 492 case BI_Arity: 493 Am; 494 Am; 495 ArgDesc; 496 break; 497 498 case BI_Addi: 499 Am; 500 Integer; 501 Am; 502 ArgDesc; 503 break; 504 505#define NREGARG 0 506#if (NREGARG > 0) 507 case MoveAR: 508 case Get_nilAR: 509 case Out_get_nilAR: 510 case In_get_nilAR: 511 case Read_variableAR: 512 case Read_valueAR: 513 case Read_matched_valueAR: 514 case Write_valueAR: 515 case Write_local_valueAR: 516 case Put_nilAR: 517 case Out_get_listAR: 518 case Get_list_argumentsAR: 519 case Get_structure_argumentsAR: 520 case Write_variableAR: 521 case Put_variableAR: 522 case Put_listAR: 523 case Push_variableAR: 524 case Push_valueAR: 525 case Push_local_valueAR: 526 case Puts_variableAR: 527 case Puts_valueAR: 528 case Test_varAR: 529 case Test_groundAR: 530 case Push_referenceAR: 531 Ar; 532 break; 533 534 case Write_named_variableAR: 535 case Put_named_variableAR: 536 Ar; 537 NamedVar; 538 break; 539#endif /* NREGARG */ 540 541 case Read_variableL: 542 case Read_referenceL: 543 case Write_variableL: 544 case Read_valueL: 545 case Read_matched_valueL: 546 case Write_valueL: 547 case Write_local_valueL: 548 case Push_init_variableL: 549 case Push_variableL: 550 case Push_valueL: 551 case Push_local_valueL: 552 case Puts_variableL: 553 case Puts_valueL: 554 case Put_global_variableL: 555 Perm; 556 break; 557 558 case Write_named_variableL: 559 case Put_named_variableL: 560 Perm; 561 NamedVar; 562 break; 563 564 case Initialize: 565 code = _print_init_mask(code, 0); 566 break; 567 568 case Initialize_named: 569 code = _print_init_mask(code, 1); 570 break; 571 572 case Read_valueTM: 573 case Read_matched_valueTM: 574 case Match_next_metaTM: 575 case Match_metaTM: 576 case Write_valueTM: 577 case Write_local_valueTM: 578 case NextTM: 579 case ModeTM: 580 case Push_valueTM: 581 case Push_local_valueTM: 582 case Puts_valueTM: 583 case Write_next_listTM: 584 Temp; 585 break; 586 587#if (NREGTMP > 0) 588 case Read_valueTR: 589 case Read_matched_valueTR: 590 case Write_valueTR: 591 case Write_local_valueTR: 592 case NextTR: 593 case ModeTR: 594 case Push_valueTR: 595 case Push_local_valueTR: 596 case Puts_valueTR: 597 case Push_variableTR: 598 case Read_variableTR: 599 case Write_variableTR: 600 case Push_referenceTR: 601 TempR; 602 break; 603 604 case Write_named_variableTR: 605 TempR; 606 NamedVar; 607 break; 608 609#endif /* NREGTMP */ 610 611 case Move3AML: 612 Am; 613 Perm; 614 case Move2AML: 615 case Put_global_variable2AML: 616 Am; 617 Perm; 618 case MoveAML: 619 case Get_valueAML: 620 case Get_matched_valueAML: 621 case Put_variableAML: 622 case Put_unsafe_valueAML: 623 case Put_global_variableAML: 624 case Read_variable2AML: 625 case Write_variable2AML: 626 Am; 627 Perm; 628 break; 629 630 case MoveNAML: 631 Integer; 632 Am; 633 Perm; 634 break; 635 636#if (NREGARG > 0) 637 case MoveARL: 638 case Get_valueARL: 639 case Get_matched_valueARL: 640 case Put_variableARL: 641 case Put_unsafe_valueARL: 642 Ar; 643 Perm; 644 break; 645 646 case Put_named_variableARL: 647 Ar; 648 Perm; 649 NamedVar; 650 break; 651#endif /* NREGARG */ 652 653 case Put_unsafe_valueAMTM: 654 case Get_valueAMTM: 655 case Get_matched_valueAMTM: 656 Am; 657 Temp; 658 break; 659 660 case MoveTMAM: 661 Temp; 662 Am; 663 break; 664 665#if (NREGARG > 0) 666 case MoveARAM: 667 Ar; 668 Am; 669 break; 670#endif /* NREGARG */ 671 672#if (NREGARG > 0 && NREGTMP > 0) 673 case MoveTRAR: 674 TempR; 675 Ar; 676 break; 677#endif /* NREGARG && NREGTMP */ 678 679#if (NREGTMP > 0) 680 case MoveTRAM: 681 TempR; 682 Am; 683 break; 684#endif /* NREGTMP */ 685 686#if (NREGARG > 0) 687 case MoveTMAR: 688 Temp; 689 Ar; 690 break; 691#endif /* NREGARG */ 692 693 694#if (NREGTMP > 0) 695 case Get_valueAMTR: 696 case Get_matched_valueAMTR: 697 case MoveAMTR: 698 Am; 699 TempR; 700 break; 701#endif /* NREGTMP */ 702 703#if (NREGARG > 0) 704 case Put_unsafe_valueARTM: 705 case Get_valueARTM: 706 case Get_matched_valueARTM: 707 Ar; 708 Temp; 709 break; 710#endif /* NREGARG */ 711 712#if (NREGARG > 0 && NREGTMP > 0) 713 case Get_valueARTR: 714 case Get_matched_valueARTR: 715 case MoveARTR: 716 Ar; 717 TempR; 718 break; 719#endif /* NREGARG && NREGTMP */ 720 721 case Get_variableNAML: 722 VarOffset; 723 Am; 724 Perm; 725 break; 726 727 case Move3LAM: 728 Perm; 729 Am; 730 case Move2LAM: 731 Perm; 732 Am; 733 case MoveLAM: 734 Perm; 735 Am; 736 break; 737 738 case MoveNLAM: 739 Integer; 740 Perm; 741 Am; 742 break; 743 744#if (NREGARG > 0) 745 case Get_variableNARL: 746 VarOffset; 747 Ar; 748 Perm; 749 break; 750 751 case MoveLAR: 752 Perm; 753 Ar; 754 break; 755#endif /* NREGARG */ 756 757 case MoveAMAM: 758 case Get_valueAMAM: 759 case Get_matched_valueAMAM: 760 Am; 761 Am; 762 break; 763 764 case Move3LL: 765 Perm; 766 Perm; 767 /* falls through */ 768 case Move2LL: 769 Perm; 770 Perm; 771 /* falls through */ 772 case MoveLL: 773 case Get_valueLL: 774 case Write_variable2L: 775 case Write_local_value2L: 776 case Push_local_value2L: 777 case Read_variable2L: 778 Perm; 779 Perm; 780 break; 781 782#if (NREGARG > 0) 783 case MoveAMAR: 784 case Get_valueAMAR: 785 case Get_matched_valueAMAR: 786 Am; 787 Ar; 788 break; 789#endif /* NREGARG */ 790 791 case Get_atom2AM: 792 Am; 793 Atom; 794 795 case Get_atomAM: 796 case Out_get_atomAM: 797 case In_get_atomAM: 798 case Put_atomAM: 799 case Put_moduleAM: 800 Am; 801 Atom; 802 break; 803 804#if (NREGARG > 0) 805 case Get_atomAR: 806 case Out_get_atomAR: 807 case In_get_atomAR: 808 case Put_atomAR: 809 Ar; 810 Atom; 811 break; 812#endif /* NREGARG */ 813 814 case Get_atomintegerAMAM: 815 Am; 816 Atom; 817 Am; 818 Integer; 819 break; 820 821 case Get_integer2AM: 822 Am; 823 Integer; 824 825 case Get_integerAM: 826 case Out_get_integerAM: 827 case In_get_integerAM: 828 case Put_integerAM: 829 Am; 830 Integer; 831 break; 832 833#if (NREGARG > 0) 834 case Get_integerAR: 835 case Out_get_integerAR: 836 case In_get_integerAR: 837 case Put_integerAR: 838 Ar; 839 Integer; 840 break; 841#endif /* NREGARG */ 842 843 case Get_floatAM: 844 case In_get_floatAM: 845 case Out_get_floatAM: 846 case Put_floatAM: 847 Am; 848 Float; 849 break; 850 851#if (NREGARG > 0) 852 case Get_floatAR: 853 case In_get_floatAR: 854 case Out_get_floatAR: 855 case Put_floatAR: 856 Ar; 857 Float; 858 break; 859#endif /* NREGARG */ 860 861 case Get_stringAM: 862 case In_get_stringAM: 863 case Out_get_stringAM: 864 case Put_stringAM: 865 Am; 866 String; 867 break; 868 869#if (NREGARG > 0) 870 case Get_stringAR: 871 case In_get_stringAR: 872 case Out_get_stringAR: 873 case Put_stringAR: 874 Ar; 875 String; 876 break; 877#endif /* NREGARG */ 878 879 case Get_structureAM: 880 case In_get_structureAM: 881 Am; 882 Structure; 883 Code_Label; 884 break; 885 886 case Put_structureAM: 887 case Out_get_structureAM: 888 Am; 889 Structure; 890 break; 891 892#if (NREGARG > 0) 893 case Get_structureAR: 894 case In_get_structureAR: 895 Ar; 896 Structure; 897 Code_Label; 898 break; 899 900 case Out_get_structureAR: 901 case Put_structureAR: 902 Ar; 903 Structure; 904 break; 905#endif /* NREGARG */ 906 907 case Get_listAM: 908 case In_get_listAM: 909 case In_get_metaAM: 910 Am; 911 Code_Label; 912 break; 913 914 case Get_metaAM: 915 Am; 916 NamedVar; 917 break; 918 919#if (NREGARG > 0) 920 case Get_listAR: 921 case In_get_listAR: 922 Ar; 923 Code_Label; 924 break; 925#endif /* NREGARG */ 926 927 case Read_variableNL: 928 case Read_referenceNL: 929 case Write_variableNL: 930 VarOffset; 931 Perm; 932 break; 933 934 case Write_named_variableNL: 935 VarOffset; 936 Perm; 937 NamedVar; 938 break; 939 940 case Read_atom2: 941 Atom; 942 /* falls through */ 943 case Read_atom: 944 case Puts_atom: 945 Atom; 946 break; 947 948 case Read_atominteger: 949 Atom; 950 Integer; 951 break; 952 953 case Read_integeratom: 954 Integer; 955 Atom; 956 break; 957 958 case Read_integer2: 959 case Write_integer2: 960 Integer; 961 /* falls through */ 962 case Read_integer: 963 case Write_integer: 964 case Push_integer: 965 case Puts_integer: 966 case Exit_emulator: 967 case Bounce: 968 case Meta_jmp: 969 Integer; 970 break; 971 972 case Read_float: 973 case Write_float: 974 case Push_float: 975 case Puts_float: 976 Float; 977 break; 978 979 case Read_string: 980 case Write_string: 981 case Push_string: 982 case Puts_string: 983 String; 984 break; 985 986 case Write_did2: 987 Structure; 988 /* falls through */ 989 case Write_structure: 990 case Write_first_structure: 991 case Write_did: 992 case Puts_structure: 993 Structure; 994 break; 995 996 case Write_didinteger: 997 Structure; 998 Integer; 999 break; 1000 1001 case Write_integerdid: 1002 Integer; 1003 Structure; 1004 break; 1005 1006 case Read_structure: 1007 case Read_last_structure: 1008 Structure; 1009 Code_Label; 1010 break; 1011 1012 case Read_meta: 1013 case Read_last_meta: 1014 NamedVar; 1015 case Read_list: 1016 case Read_last_list: 1017 Code_Label; 1018 break; 1019 1020 case Read_structureTM: 1021 case Read_next_structureTM: 1022 case Write_next_structureTMlab: 1023 Structure; 1024 case NextTMlab: 1025 case ModeTMlab: 1026 case Read_listTM: 1027 case Read_next_listTM: 1028 case Write_next_listTMlab: 1029 Temp; 1030 Code_Label; 1031 break; 1032 1033 case Write_next_structureTM: 1034 Structure; 1035 Temp; 1036 break; 1037 1038 case Read_metaTM: 1039 case Read_next_metaTM: 1040 Temp; 1041 NamedVar; 1042 Code_Label; 1043 break; 1044 1045#if (NREGTMP > 0) 1046 case Read_structureTR: 1047 case Read_next_structureTR: 1048 Structure; 1049 case NextTRlab: 1050 case ModeTRlab: 1051 case Read_listTR: 1052 case Read_next_listTR: 1053 TempR; 1054 Code_Label; 1055 break; 1056 case Get_constantAR: 1057 case Out_get_constantAR: 1058 case In_get_constantAR: 1059 Ar; Const; Consttag; 1060 break; 1061 case Put_constantAR: 1062 Ar; Consttag; Const; 1063 break; 1064 1065 1066#endif /* NREGTMP */ 1067 1068 case Puts_constant: 1069 Consttag; Const; 1070 break; 1071 1072 case Read_constant: 1073 case Write_constant: 1074 case Push_constant: 1075 Const; Consttag; 1076 break; 1077 1078 case Get_constantAM: 1079 case Out_get_constantAM: 1080 case In_get_constantAM: 1081 Am; Const; Consttag; 1082 break; 1083 1084 case Put_constantAM: 1085 Am; Consttag; Const; 1086 break; 1087 1088 case Retry_me_else: 1089 case Retry: 1090 Port; 1091 Code_Label; 1092 break; 1093 1094 case Retry_inline: 1095 Port; 1096 Code_Label; 1097 EnvDesc; 1098 break; 1099 1100 case Trust: 1101 Port; 1102 Code_Label; 1103 Nl; 1104 break; 1105 1106 case Trust_inline: 1107 Port; 1108 Code_Label; 1109 EnvDesc; 1110 Nl; 1111 break; 1112 1113 case Branchs: 1114 VarOffset; 1115 case Branch: 1116 Code_Label; 1117 break; 1118 1119 case Set_bp: 1120 case New_bp: 1121 Code_Label; 1122 break; 1123 1124 case Try_me_else: 1125 Port; 1126 Integer; 1127 Code_Label; 1128 break; 1129 1130 case Retry_me_inline: 1131 Port; 1132 Code_Label; 1133 EnvDesc; 1134 break; 1135 1136 case Trust_me_inline: 1137 Port; 1138 EnvDesc; 1139 break; 1140 1141 case Try_parallel: 1142 { 1143 word nalt; 1144 uword *ptr; 1145 1146 nalt = (word) *code; 1147 Integer; 1148 Integer; 1149 ptr = (uword *) *code++; 1150 if (ptr) 1151 { 1152 do 1153 { 1154 p_fprintf(current_output_, "\n\t\t\t\t"); 1155 _print_label((vmcode **) ptr); 1156 ptr++; 1157 } while (nalt--); 1158 } 1159 } 1160 break; 1161 1162 case Retry_seq: 1163 case Try_clause: 1164 Addr; 1165 break; 1166 1167 case GuardL: 1168 VarOffset; 1169 Code_Label; 1170 break; 1171 1172 case Try: 1173 Port; 1174 Integer; 1175 Code_Label; 1176 break; 1177 1178 case Trylab: 1179 Port; 1180 Integer; 1181 Code_Label; 1182 Code_Label; 1183 Nl; 1184 break; 1185 1186 case Retrylab: 1187 Port; 1188 Code_Label; 1189 Code_Label; 1190 Nl; 1191 break; 1192 1193 case Try_me_dynamic: 1194 case Retry_me_dynamic: 1195#ifdef OLD_DYNAMIC 1196 Integer; 1197 Integer; 1198 Save_Label; 1199 if (*code == SRC_CLAUSE_ARITY) 1200 p_fprintf(current_output_,"SOURCE "); 1201 p_fprintf(current_output_,"%d ", 1202 (*code++) & SRC_CLAUSE_ARITY_MASK); 1203 Code_Label; 1204#endif 1205 break; 1206 1207 case Push_referenceAM: 1208 Am; 1209 case Allocate: 1210 case Wake_init: 1211 case Space: 1212 case Exits: 1213 case Push_structure: 1214 case Push_reference: 1215 case Push_void_reference: 1216 case Read_attribute: 1217 case Read_voidN: 1218 case Write_voidN: 1219 case Push_voidN: 1220 case Puts_valueG: 1221 case Push_valueG: 1222 VarOffset; 1223 break; 1224 1225 case Gc_testA: 1226 Integer; 1227 case Gc_test: 1228 case Gc: 1229 Integer; 1230 break; 1231 1232 case Cut: 1233 case Cut_single: 1234 VarOffset; 1235 break; 1236 1237 case MoveLAMCallfA: 1238 Perm; 1239 Am; 1240 case CallfA: 1241 case CallA: 1242 Addr; 1243 EnvDesc; 1244 break; 1245 1246 case Put_global_variableAMLCallfA: 1247 Am; 1248 Perm; 1249 Addr; 1250 EnvDesc; 1251 break; 1252 1253 case JmpdAs: 1254 VarOffset; 1255 case JmpA: 1256 case JmpdA: 1257 case ChainA: 1258 case ChaincA: 1259 case ChaindA: 1260 case Meta_jmpA: 1261 Addr; 1262 Nl; 1263 break; 1264 1265 case MoveLAMChainA: 1266 Perm; 1267 Am; 1268 Addr; 1269 Nl; 1270 break; 1271 1272 case MoveLAMCallfP: 1273 Perm; 1274 Am; 1275 case CallfP: 1276 case CallP: 1277 Proc; 1278 case Metacall: 1279 case Handler_call: 1280 case Suspension_call: 1281 case Fail_clause: 1282 EnvDesc; 1283 break; 1284 1285 case Put_global_variableAMLCallfP: 1286 Am; 1287 Perm; 1288 Proc; 1289 EnvDesc; 1290 break; 1291 1292 case Fastcall: 1293 Port; 1294 EnvDesc; 1295 break; 1296 1297 case MoveLAMChainP: 1298 Perm; 1299 Am; 1300 case JmpP: 1301 case JmpdP: 1302 case ChainP: 1303 case ChaincP: 1304 case ChaindP: 1305 Proc; 1306 Nl; 1307 break; 1308 1309 case Ret: 1310 case Retn: 1311 case Retd: 1312 case Retd_nowake: 1313 case Ret_nowake: 1314 case Exit: 1315 case Exitd: 1316 case Exitd_nowake: 1317 case Exitc: 1318 Nl; 1319 break; 1320 1321 case Savecut: 1322 case Neckcut: 1323 case Neckcut_par: 1324 case Deallocate: 1325 case Restore_bp: 1326 case Catch: 1327 case Throw: 1328 case Suspension_jmp: 1329 case Explicit_jmp: 1330 case Wake: 1331 break; 1332 1333 case Trust_me: 1334 Port; 1335 break; 1336 1337 case SavecutL: 1338 case SoftcutL: 1339 case Dfid_testL: 1340 case Depth: 1341 Perm; 1342 break; 1343 1344 case CutL: 1345 case Push_referenceL: 1346 case Push_init_referenceL: 1347 Perm; 1348 VarOffset; 1349 break; 1350 1351 case CutAMN: 1352 Am; 1353 VarOffset; 1354 break; 1355 1356 case ExtCall: 1357 ExtCallName; 1358 break; 1359 1360 case Escape: 1361 EsuName; 1362 break; 1363 1364 case External: 1365 case External0: 1366 case External1: 1367 case External2: 1368 case External3: 1369 case Call_dynamic: 1370 Proc; 1371 Addr; 1372 break; 1373 1374 case Debug_call: 1375 Proc; 1376 Port; 1377 Atom; 1378 Integer; 1379 Integer; 1380 Integer; 1381 break; 1382 1383 case Debug_call_simple: 1384 Proc; 1385 Port; 1386 Atom; 1387 Integer; 1388 Integer; 1389 Integer; 1390 case Debug_exit_simple_args: 1391 Integer; /* argument descriptor minitags */ 1392 Integer; /* offset */ 1393 case Debug_exit_simple: 1394 break; 1395 1396 case List_switchL: 1397 Perm; 1398 goto _list_switch_; 1399 1400 case List_switchAM: 1401 Am; 1402_list_switch_: 1403 if (option & ALS) { 1404 Code_Label; 1405 Code_Label; 1406 Code_Label; 1407 } 1408 break; 1409 1410#if (NREGARG > 0) 1411 case List_switchAR: 1412 Ar; 1413 if (option & ALS) { 1414 Code_Label; 1415 Code_Label; 1416 Code_Label; 1417 } 1418 break; 1419#endif /* NREGARG */ 1420 1421#if (NREGARG > 0) 1422 case Atom_switchAR: 1423 Ar; 1424 if (option & ALS) { 1425 Atom_Table2; 1426 Code_Label; 1427 } 1428 break; 1429#endif /* NREGARG */ 1430 1431 case Atom_switchL: 1432 Perm; 1433 goto _atom_switch_; 1434 1435 case Atom_switchAM: 1436 Am; 1437_atom_switch_: 1438 if (option & ALS) { 1439 Atom_Table2; 1440 Code_Label; 1441 } 1442 break; 1443 1444 case Functor_switchL: 1445 Perm; 1446 goto _functor_switch_; 1447 1448 case Functor_switchAM: 1449 Am; 1450_functor_switch_: 1451 if (option & ALS) { 1452 Functor_Table2; 1453 Code_Label; 1454 } 1455 break; 1456 1457#if (NREGARG > 0) 1458 case Functor_switchAR: 1459 Ar; 1460 if (option & ALS) { 1461 Functor_Table2; 1462 Code_Label; 1463 } 1464 break; 1465#endif /* NREGARG */ 1466 1467 case Integer_switchL: 1468 Perm; 1469 goto _integer_switch_; 1470 1471 case Integer_switchAM: 1472 Am; 1473_integer_switch_: 1474 if (option & ALS) { 1475 Integer_Table2; 1476 Code_Label; 1477 } 1478 break; 1479 1480#if (NREGARG > 0) 1481 case Integer_switchAR: 1482 Ar; 1483 if (option & ALS) { 1484 Integer_Table2; 1485 Code_Label; 1486 } 1487 break; 1488#endif /* NREGARG */ 1489 1490 case Integer_range_switchL: 1491 Perm; 1492 goto _integer_range_switch_; 1493 1494 case Integer_range_switchAM: 1495 Am; 1496_integer_range_switch_: 1497 if (option & ALS) { 1498 Integer_Range_Table; 1499 } 1500 break; 1501 1502 case Switch_on_typeL: 1503 Perm; 1504 goto _switch_on_type_; 1505 1506 case Switch_on_typeAM: 1507 Am; 1508_switch_on_type_: 1509 if (option & ALS) 1510 { 1511 int i; 1512 for (i = 0; i < NTYPES; i++) 1513 { 1514 p_fprintf(current_output_, "\n\t\t\t%-16s", 1515 DidName(tag_desc[i].tag_name)); 1516 Code_Label; 1517 } 1518 } 1519 break; 1520 1521#if (NREGARG > 0) 1522 case Switch_on_typeAR: 1523 Ar; 1524 if (option & ALS) 1525 { 1526 int i; 1527 for (i = 0; i < NTYPES; i++) 1528 { 1529 p_fprintf(current_output_, "\n\t\t\t%d: ", i); 1530 Code_Label; 1531 } 1532 } 1533 break; 1534#endif /* NREGARG */ 1535 1536 case Ress: 1537 VarOffset; 1538 case Res: 1539 Integer; 1540 EnvDesc; 1541 break; 1542 1543 case Continue_after_event: 1544 case Continue_after_event_debug: 1545 case Debug_exit: 1546 case BI_ContDebug: 1547 break; 1548 1549 case Puts_proc: 1550 case Undefined: 1551 Proc; 1552 break; 1553 1554 default: 1555 p_fprintf(current_output_, "Undefined opcode in print_am: %d", *(code - 1)); 1556 code = 0; 1557 } 1558 } 1559 (void) ec_newline(current_output_); /* to flush if tty */ 1560 return code; 1561} 1562 1563static void 1564_print_label(vmcode **ptr) 1565{ 1566 char *instr; 1567 int inst; 1568 1569 p_fprintf(current_output_,"%d(", (word) (*ptr) 1570#ifndef PRINTAM 1571 & 0xfff 1572#endif 1573 ); 1574 if (InvalidAddress(*ptr)) 1575 ec_outfs(current_output_, "BAD ADDRESS"); 1576 else { 1577 inst = Get_Int_Opcode(*ptr); 1578 if (inst < 0 || inst > NUMBER_OP) 1579 inst = Inst_Error; 1580 instr = inst_name[inst]; 1581 while (*instr != ' ') 1582 (void) ec_outfc(current_output_, *instr++); 1583 } 1584 (void) ec_outfc(current_output_, ')'); 1585} 1586 1587static vmcode * 1588_print_init_mask(vmcode *code, int name) 1589{ 1590 word pos = (*code++)/(word)sizeof(pword); 1591 unsigned init_mask = *code++; 1592 1593 if (name) 1594 { 1595 if (IsTag(*code,TNAME)) 1596 p_fprintf(current_output_,"%s-", DidName(TagDid(*code))); 1597 code++; 1598 } 1599 p_fprintf(current_output_,"Y%d ", pos++); 1600 while (init_mask) 1601 { 1602 if (init_mask & 1) 1603 { 1604 if (name) 1605 { 1606 if (IsTag(*code,TNAME)) 1607 p_fprintf(current_output_,"%s-", DidName(TagDid(*code))); 1608 code++; 1609 } 1610 p_fprintf(current_output_,"Y%d ", pos); 1611 } 1612 init_mask >>= 1; 1613 pos++; 1614 } 1615 return code; 1616} 1617 1618 1619static void 1620_print_edesc(uword edesc) 1621{ 1622 if (EdescIsSize(edesc)) 1623 { 1624 /* size might be -1 */ 1625 p_fprintf(current_output_,"%d ", (word)edesc/(word)sizeof(pword)); 1626 } 1627 else 1628 { 1629 uword pos = 1; 1630 int first = 1; 1631 uword *eam_ptr = EdescEamPtr(edesc); 1632 p_fprintf(current_output_,"Y["); 1633 do { 1634 int i; 1635 uword eam = EamPtrEam(eam_ptr); 1636 for(i=EAM_CHUNK_SZ;i>0;--i) { 1637 if (eam & 1) { 1638 if (first) { 1639 first = 0; 1640 p_fprintf(current_output_,"%d", pos); 1641 } else { 1642 p_fprintf(current_output_,",%d", pos); 1643 } 1644 } 1645 eam >>= 1; 1646 pos++; 1647 } 1648 } while (EamPtrNext(eam_ptr)); 1649 p_fprintf(current_output_,"]"); 1650 } 1651} 1652 1653 1654void 1655print_port(stream_id nst, int port) 1656{ 1657 (void) p_fprintf(nst,"%s%s%s%s%s%s", 1658 port & FIRST_CALL ? "F|" : "", 1659 port & LAST_CALL ? "L|" : "", 1660 port & NO_ARGS ? "NA|" : "", 1661 port & INLINE_PORT ? "I|" : "", 1662 port & BREAKPOINT ? "B|" : "", 1663 PortName(port) + 1 1664 ); 1665} 1666 1667#ifdef PRINTAM 1668 1669/* 1670 * Utility for debugging 1671 */ 1672 1673#define EnQueue_(pw, arity) { \ 1674 if (queue_head) { \ 1675 queue_tail[1].val.ptr = (pword *) hg_alloc_size(2*sizeof(pword));\ 1676 queue_tail = queue_tail[1].val.ptr; \ 1677 } else \ 1678 queue_tail = queue_head = (pword *) hg_alloc_size(2*sizeof(pword));\ 1679 queue_tail[0].val.ptr = (pw); \ 1680 queue_tail[0].tag.kernel = (arity); \ 1681 queue_tail[1].val.ptr = (pword *) 0; \ 1682} 1683 1684#define DeQueue_(pw, arity) { \ 1685 register pword *elem = queue_head; \ 1686 (pw) = elem[0].val.ptr; \ 1687 (arity) = elem[0].tag.kernel; \ 1688 queue_head = elem[1].val.ptr; \ 1689 hg_free_size((generic_ptr)elem, 2*sizeof(pword)); \ 1690} 1691 1692#define EmptyQueue() (!queue_head) 1693 1694#define TUNKNOWN (TFORWARD-1) 1695 1696static char * tag_string[] = { 1697 "???? ", /* -7 */ 1698 "TFORWARD", /* -6 */ 1699 "TSTAMP ", /* -5 */ 1700 "TUNIV ", /* -4 */ 1701 "TMETA ", /* -3 */ 1702 "TNAME ", /* -2 */ 1703 "TVAR ", /* -1 */ 1704 "TLIST ", 1705 "TCOMP ", 1706 "TSUSP ", 1707 "THANDLE ", 1708 "TSTRG ", 1709 "TBIG ", 1710 "TIVL ", 1711 "TRAT ", 1712 "TDBL ", 1713 "TNIL ", 1714 "TINT ", 1715 "TDICT ", 1716 "TPTR ", 1717 "TPROC ", 1718 "TEND ", 1719 "TDE ", 1720 "TGRS ", 1721 "TGRL ", 1722 "TEXTERN ", 1723 "TBUFFER " 1724 "TVARNUM ", 1725 }; 1726 1727p_pw(value v, type t) 1728{ 1729 pword pw; 1730 pw.val.all = v.all; 1731 pw.tag.all = t.all; 1732 return ppw(&pw); 1733} 1734 1735ppw(pword *pw) /* print prolog words */ 1736 1737{ 1738 1739 int arity = 1; 1740 pword *queue_head = (pword *) 0; 1741 pword *queue_tail = (pword *) 0; 1742 1743 for (;;) 1744 { 1745 char region; 1746 int t = TagType(pw->tag); 1747 1748 if (t < TFORWARD || t > TBUFFER) 1749 t = TUNKNOWN; 1750 1751 if (TG_ORIG <= pw && pw < TG) region = 'g'; 1752 else if (SP <= pw && pw < SP_ORIG) region = 'l'; 1753 else if (B_ORIG <= pw && pw < B.args) region = 'c'; 1754 else if (TT <= (pword **) pw && (pword **) pw < TT_ORIG) region = 't'; 1755 else if (address_in_heap(&global_heap, (generic_ptr) pw)) region = 'h'; 1756 else region = '?'; 1757 1758 p_fprintf(current_output_, "%c 0x%08x: 0x%08x 0x%08x %s ", region, 1759 pw, pw->val.all, pw->tag.all, tag_string[t-TUNKNOWN]); 1760 switch (t) 1761 { 1762 case TFORWARD: 1763 case TMETA: 1764 case TNAME: 1765 if (pw != pw->val.ptr) 1766 { 1767 ec_outfs(current_output_, "--->"); 1768 EnQueue_(pw->val.ptr, 1); 1769 } 1770 else 1771 { 1772 ec_outfs(current_output_, IsNamed(pw->tag.kernel) ? 1773 DidName(TagDid(pw->tag.kernel)) : "_"); 1774 } 1775 break; 1776 case TVAR_TAG: 1777 if (pw != pw->val.ptr) 1778 { 1779 ec_outfs(current_output_, "--->"); 1780 EnQueue_(pw->val.ptr, 1); 1781 } 1782 else 1783 ec_outfs(current_output_, "_"); 1784 break; 1785 case TLIST: 1786 EnQueue_(pw->val.ptr, 2); 1787 break; 1788 case TCOMP: 1789 if (pw->val.ptr) 1790 EnQueue_(pw->val.ptr, DidArity(pw->val.ptr->val.did)+1); 1791 break; 1792 case TSTRG: 1793 ec_outfs(current_output_, StringStart(pw->val)); 1794 break; 1795 case TSUSP: 1796 break; 1797 case TDE: 1798 break; 1799 case THANDLE: 1800 break; 1801 case TNIL: 1802 break; 1803 case TINT: 1804 p_fprintf(current_output_, "%d", pw->val.nint); 1805 break; 1806 case TDICT: 1807 ec_outfs(current_output_, DidName(pw->val.did)); 1808 if (DidArity(pw->val.did)) 1809 p_fprintf(current_output_, "/%d", DidArity(pw->val.did)); 1810 break; 1811 case TPTR: 1812 break; 1813 case TPROC: 1814 case TEND: 1815 case TVARNUM: 1816 case TGRS: 1817 case TGRL: 1818 case TEXTERN: 1819 case TBUFFER: 1820 break; 1821 case TDBL: 1822 p_fprintf(current_output_, "%f", Dbl(pw->val)); 1823 break; 1824 case TBIG: 1825 case TRAT: 1826 default: 1827 if (t >= 0 && t <= NTYPES) 1828 { 1829 (void) tag_desc[t].write(QUOTED, current_output_, 1830 pw->val, pw->tag); 1831 } 1832 break; 1833 } 1834 ec_newline(current_output_); 1835 if (--arity > 0) 1836 { 1837 pw++; 1838 continue; 1839 } 1840 ec_newline(current_output_); 1841 if (EmptyQueue()) 1842 break; 1843 DeQueue_(pw, arity); 1844 } 1845 Succeed_; 1846} 1847 1848#endif /* PRINTAM */ 1849 1850#ifdef THREADED 1851 1852int 1853get_int_opcode(code) 1854vmcode *code; 1855{ 1856 register vmcode op = *code; 1857 register vmcode *p, *stop; 1858 1859 if (op == Code_end) 1860 return Code_end; 1861 p = &op_addr[0]; 1862 stop = &op_addr[NUMBER_OP - 1]; 1863 while (p <= stop) 1864 if (op == *p++) 1865 return p - &op_addr[1]; 1866 1867 1868 return Inst_Error; 1869} 1870 1871#endif /* THREADED */ 1872 1873#endif /* NOALS */ 1874