home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / t / toaster.zip / Compat / interpret.c < prev    next >
C/C++ Source or Header  |  1992-01-06  |  144KB  |  5,707 lines
  1. #include <varargs.h>
  2. #include <stdio.h>
  3. #include <setjmp.h>
  4. #include <string.h>
  5. #include <ctype.h>
  6. #include <sys/time.h>
  7. #include <sys/types.h>        /* sys/types.h and netinet/in.h are here to enable include of comm.h below */
  8. #include <sys/stat.h>
  9. #ifdef MARK
  10. #include <prof.h>
  11. #endif
  12. #include <memory.h>
  13.  
  14. #ifdef MARK
  15. #define CASE(x) case x: MARK(x);
  16. #else
  17. #define CASE(x) case x:
  18. #endif
  19.  
  20. #include "lint.h"
  21. #include "lang.h"
  22. #include "exec.h"
  23. #include "interpret.h"
  24. #include "config.h"
  25. #include "object.h"
  26. #include "wiz_list.h"
  27. #include "instrs.h"
  28. #include "patchlevel.h"
  29. #include "comm.h"
  30. #include "switch.h"
  31.  
  32. #ifdef RUSAGE            /* Defined in config.h */
  33. #include <sys/resource.h>
  34. extern int getrusage PROT((int, struct rusage *));
  35. #ifdef sun
  36. extern int getpagesize();
  37. #endif
  38. #ifndef RUSAGE_SELF
  39. #define RUSAGE_SELF    0
  40. #endif
  41. #endif
  42.  
  43. #if defined(__GNUC__) && !defined(lint)
  44. #define INLINE /* inline */ /* Another time ! */
  45. #else
  46. #define INLINE
  47. #endif
  48.  
  49. extern void print_svalue PROT((struct svalue *));
  50. extern void say PROT((struct svalue *, struct vector *));
  51. static struct svalue *sapply PROT((char *, struct object *, int));
  52. static void do_trace PROT((char *, char *, char *));
  53. static int apply_low PROT((char *, struct object *, int));
  54. static int inter_sscanf PROT((int));
  55. extern int remote_command;
  56. static int strpref PROT((char *, char *));
  57.  
  58. extern struct object *obj_list_destruct;
  59. extern struct object *previous_ob;
  60. extern char *last_verb, *last_arg;
  61. extern struct svalue const0, const1;
  62. struct program *current_prog;
  63. struct object *frame_ob;
  64. extern int current_time;
  65. extern struct object *current_heart_beat, *current_interactive;
  66.  
  67. static int tracedepth;
  68. #define TRACE_CALL 1
  69. #define TRACE_CALL_OTHER 2
  70. #define TRACE_RETURN 4
  71. #define TRACE_ARGS 8
  72. #define TRACE_EXEC 16
  73. #define TRACE_HEART_BEAT 32
  74. #define TRACE_APPLY 64
  75. #define TRACE_OBJNAME 128
  76. #define TRACETST(b) (command_giver->interactive->trace_level & (b))
  77. #define TRACEP(b) \
  78.     (command_giver && command_giver->interactive && TRACETST(b) && \
  79.      (command_giver->interactive->trace_prefix == 0 || \
  80.       (current_object && strpref(command_giver->interactive->trace_prefix, \
  81.           current_object->name))) )
  82. #define TRACEHB (current_heart_beat == 0 || (command_giver->interactive->trace_level & TRACE_HEART_BEAT))
  83.  
  84. /*
  85.  * Inheritance:
  86.  * An object X can inherit from another object Y. This is done with
  87.  * the statement 'inherit "file";'
  88.  * The inherit statement will clone a copy of that file, call reset
  89.  * in it, and set a pointer to Y from X.
  90.  * Y has to be removed from the linked list of all objects.
  91.  * All variables declared by Y will be copied to X, so that X has access
  92.  * to them.
  93.  *
  94.  * If Y isn't loaded when it is needed, X will be discarded, and Y will be
  95.  * loaded separetly. X will then be reloaded again.
  96.  */
  97. extern int d_flag;
  98.  
  99. extern int current_line, eval_cost;
  100.  
  101. /*
  102.  * These are the registers used at runtime.
  103.  * The control stack saves registers to be restored when a function
  104.  * will return. That means that control_stack[0] will have almost no
  105.  * interesting values, as it will terminate execution.
  106.  */
  107. static char *pc;        /* Program pointer. */
  108. static struct svalue *fp;    /* Pointer to first argument. */
  109. static struct svalue *sp;    /* Points to value of last push. */
  110. static short *break_sp;        /* Points to address to branch to
  111.                  * at next F_BREAK            */
  112. static int function_index_offset; /* Needed for inheritance */
  113. static int variable_index_offset; /* Needed for inheritance */
  114.  
  115. static struct svalue start_of_stack[EVALUATOR_STACK_SIZE];
  116. struct svalue catch_value;    /* Used to throw an error to a catch */
  117.  
  118. static struct control_stack control_stack[MAX_TRACE];
  119. static struct control_stack *csp;    /* Points to last element pushed */
  120.  
  121. /*
  122.  * May current_object shadow object 'ob' ? We rely heavily on the fact that
  123.  * function names are pointers to shared strings, which means that equality
  124.  * can be tested simply through pointer comparison.
  125.  */
  126. int validate_shadowing(ob)
  127.     struct object *ob;
  128. {
  129.     int i, j;
  130.     struct program *shadow = current_object->prog, *victim = ob->prog;
  131.     struct svalue *ret;
  132.  
  133.     if (current_object->shadowing)
  134.     error("shadow: Already shadowing.\n");
  135.     if (current_object->shadowed)
  136.     error("shadow: Can't shadow when shadowed.\n");
  137.     if (current_object->super)
  138.     error("The shadow must not reside inside another object.\n");
  139.     if (ob->shadowing)
  140.     error("Can't shadow a shadow.\n");
  141.     for (i=0; i < shadow->num_functions; i++) {
  142.     for (j=0; j < victim->num_functions; j++) {
  143.         if (shadow->functions[i].name != victim->functions[j].name)
  144.         continue;
  145.         if (victim->functions[j].type & TYPE_MOD_NO_MASK)
  146.         error("Illegal to shadow 'nomask' function \"%s\".\n",
  147.               victim->functions[j].name);
  148.     }
  149.     }
  150.     push_object(ob, "validate_shadowing");
  151.     ret = apply_master_ob("query_allow_shadow", 1);
  152.     if (!(ob->flags & O_DESTRUCTED) &&
  153.     ret && !(ret->type == T_NUMBER && ret->u.number == 0))
  154.     {
  155.     return 1;
  156.     }
  157.     return 0;
  158. }
  159.  
  160. /*
  161.  * Information about assignments of values:
  162.  *
  163.  * There are three types of l-values: Local variables, global variables
  164.  * and vector elements.
  165.  *
  166.  * The local variables are allocated on the stack together with the arguments.
  167.  * the register 'frame_pointer' points to the first argument.
  168.  *
  169.  * The global variables must keep their values between executions, and
  170.  * have space allocated at the creation of the object.
  171.  *
  172.  * Elements in vectors are similar to global variables. There is a reference
  173.  * count to the whole vector, that states when to deallocate the vector.
  174.  * The elements consists of 'struct svalue's, and will thus have to be freed
  175.  * immediately when over written.
  176.  */
  177.  
  178. /*
  179.  * Push an object pointer on the stack. Note that the reference count is
  180.  * incremented. 
  181.  * A destructed object must never be pushed on the stack.
  182.  */
  183. INLINE
  184. void push_object(ob, from)
  185.     struct object *ob;
  186.     char *from;
  187. {
  188.     char buf[50];
  189.     sp++;
  190.     if (sp == &start_of_stack[EVALUATOR_STACK_SIZE])
  191.     fatal("stack overflow\n");
  192.     sp->type = T_OBJECT;
  193.     sp->u.ob = ob;
  194.     if (from)
  195.        sprintf(buf, "push_object (%s)", from);
  196.     else strcpy(buf, "push_object");
  197.     add_ref(ob, buf);
  198. }
  199.  
  200. /*
  201.  * Push a number on the value stack.
  202.  */
  203. INLINE
  204. void push_number(n)
  205.     int n;
  206. {
  207.     sp++;
  208.     if (sp == &start_of_stack[EVALUATOR_STACK_SIZE])
  209.     fatal("stack overflow\n");
  210.     sp->type = T_NUMBER;
  211.     sp->u.number = n;
  212. }
  213.  
  214. /*
  215.  * Push a string on the value stack.
  216.  */
  217. INLINE
  218. void push_string(p, type)
  219.     char *p;
  220.     int type;
  221. {
  222.     sp++;
  223.     if (sp == &start_of_stack[EVALUATOR_STACK_SIZE])
  224.     fatal("stack overflow\n");
  225.     sp->type = T_STRING;
  226.     sp->string_type = type;
  227.     switch(type) {
  228.     case STRING_MALLOC:
  229.     sp->u.string = string_copy(p);
  230.     break;
  231.     case STRING_SHARED:
  232.     sp->u.string = make_shared_string(p);
  233.     break;
  234.     case STRING_CONSTANT:
  235.     sp->u.string = p;
  236.     break;
  237.     }
  238. }
  239.  
  240. /*
  241.  * Get address to a valid global variable.
  242.  */
  243. static INLINE struct svalue *find_value(num)
  244.     int num;
  245. {
  246. #ifdef DEBUG
  247.     if (num >= current_object->prog->num_variables) {
  248.     fatal("Illegal variable access %d(%d). See trace above.\n",
  249.         num, current_object->prog->num_variables);
  250.     }
  251. #endif
  252.     return ¤t_object->variables[num];
  253. }
  254.  
  255.  
  256. /*
  257.  * Free the data that an svalue is pointing to. Not the svalue
  258.  * itself.
  259.  */
  260. void free_svalue(v, from)
  261.     struct svalue *v;
  262.     char *from;
  263. {
  264.     switch(v->type) {
  265.     case T_STRING:
  266.     switch(v->string_type) {
  267.     case STRING_MALLOC:
  268.         free(v->u.string);
  269.         break;
  270.     case STRING_SHARED:
  271.         free_string(v->u.string);
  272.         break;
  273.     }
  274.     break;
  275.     case T_OBJECT:
  276.     {
  277.         char buf[80]; strcpy(buf, "free_svalue ");
  278.         if (from) { strcat(buf, "("); strcat(buf, from); strcat(buf, ")"); }
  279.     free_object(v->u.ob, buf);
  280.     break;
  281.     }
  282.     case T_POINTER:
  283.     free_vector(v->u.vec);
  284.     break;
  285.     }
  286.     *v = const0;
  287. }
  288.  
  289. #ifndef COMPAT_MODE
  290. /*
  291.  * Prepend a slash in front of a string.
  292.  */
  293. static char *add_slash(str)
  294.     char *str;
  295. {
  296.     char *tmp;
  297.  
  298.     tmp = xalloc(strlen(str)+2);
  299.     strcpy(tmp,"/"); strcat(tmp,str);
  300.     return tmp;
  301. }
  302. #endif
  303.  
  304. /*
  305.  * Assign to a svalue.
  306.  * This is done either when element in vector, or when to an identifier
  307.  * (as all identifiers are kept in a vector pointed to by the object).
  308.  */
  309.  
  310. INLINE void assign_svalue_no_free(to, from)
  311.     struct svalue *to;
  312.     struct svalue *from;
  313. {
  314. #ifdef DEBUG
  315.     if (from == 0)
  316.     fatal("Null pointer to assign_svalue().\n");
  317. #endif
  318.     *to = *from;
  319.     switch(from->type) {
  320.     case T_STRING:
  321.     switch(from->string_type) {
  322.     case STRING_MALLOC:    /* No idea to make the string shared */
  323.         to->u.string = string_copy(from->u.string);
  324.         break;
  325.     case STRING_CONSTANT:    /* Good idea to make it shared */
  326.         to->string_type = STRING_SHARED;
  327.         /* FALL THROUGH ! */
  328.     case STRING_SHARED:    /* It already is shared */
  329.         to->u.string = make_shared_string(from->u.string);
  330.         break;
  331.     default:
  332.         fatal("Bad string type %d\n", from->string_type);
  333.     }
  334.     break;
  335.     case T_OBJECT:
  336.     add_ref(to->u.ob, "ass to var");
  337.     break;
  338.     case T_POINTER:
  339.     to->u.vec->ref++;
  340.     break;
  341.     }
  342. }
  343.  
  344. INLINE void assign_svalue(dest, v)
  345.     struct svalue *dest;
  346.     struct svalue *v;
  347. {
  348.     /* First deallocate the previous value. */
  349.     free_svalue(dest, "assign_svalue");
  350.     assign_svalue_no_free(dest, v);
  351. }
  352.  
  353. void push_svalue(v)
  354.     struct svalue *v;
  355. {
  356.     sp++;
  357.     assign_svalue_no_free(sp, v);
  358. }
  359.  
  360. static INLINE void pop_stack() {
  361. #ifdef DEBUG
  362.     if (sp < start_of_stack)
  363.     fatal("Stack underflow.\n");
  364. #endif
  365.     free_svalue(sp, "pop_stack");
  366.     sp--;
  367. }
  368.  
  369. /*
  370.  * Compute the address of an array element.
  371.  */
  372. static INLINE void push_indexed_lvalue()
  373. {
  374.     struct svalue *vec, *item;
  375.     int ind;
  376.  
  377.     ind = sp->u.number;
  378.     vec = sp - 1;
  379.     if (sp->type != T_NUMBER || ind < 0)
  380.     error("Illegal index\n");
  381.     pop_stack();
  382.     if (vec->type == T_STRING) {
  383.     static struct svalue one_character;
  384.     /* marion says: this is a crude part of code */
  385.     one_character.type = T_NUMBER;
  386.     if (ind > strlen(vec->u.string) || ind < 0)
  387.         one_character.u.number = 0;
  388.     else
  389.         one_character.u.number = vec->u.string[ind];
  390.     free_svalue(sp, "push_indexed_lvalue");
  391.     sp->type = T_LVALUE;
  392.     sp->u.lvalue = &one_character;
  393.     return;
  394.     }
  395.     if (vec->type != T_POINTER) error("Indexing on illegal type.\n");
  396.     if (ind >= vec->u.vec->size) error ("Index out of bounds\n");
  397.     item = &vec->u.vec->item[ind];
  398.     if (vec->u.vec->ref == 1) {
  399.     static struct svalue quickfix = { T_NUMBER };
  400.     /* marion says: but this is crude too */
  401.     /* marion blushes. */
  402.     assign_svalue (&quickfix, item);
  403.     item = &quickfix;
  404.     }
  405.     free_svalue(sp, "push_indexed_lvalue");        
  406.               /* This will make 'vec' invalid to use */
  407.     sp->type = T_LVALUE;
  408.     sp->u.lvalue = item;
  409. }
  410.  
  411. #ifdef OPCPROF
  412. #define MAXOPC 512
  413. static int opcount[MAXOPC];
  414. #endif
  415.  
  416. /*
  417.  * Deallocate 'n' values from the stack.
  418.  */
  419. INLINE
  420. void pop_n_elems(n)
  421.     int n;
  422. {
  423. #ifdef DEBUG
  424.     if (n < 0)
  425.     fatal("pop_n_elems: %d elements.\n", n);
  426. #endif
  427.     for (; n>0; n--)
  428.     pop_stack();
  429. }
  430.  
  431. void bad_arg(arg, instr)
  432.     int arg, instr;
  433. {
  434.     error("Bad argument %d to %s()\n", arg, get_f_name(instr));
  435. }
  436.  
  437. INLINE
  438. static void push_control_stack(funp)
  439.     struct function *funp;
  440. {
  441.     if (csp == &control_stack[MAX_TRACE-1])
  442.     error("Too deep recursion.\n");
  443.     csp++;
  444.     csp->funp = funp;    /* Only used for tracebacks */
  445.     csp->ob = current_object;
  446.     csp->prev_ob = previous_ob;
  447.     csp->fp = fp;
  448.     csp->prog = current_prog;
  449.     /* csp->extern_call = 0; It is set by eval_instruction() */
  450.     csp->pc = pc;
  451.     csp->function_index_offset = function_index_offset;
  452.     csp->variable_index_offset = variable_index_offset;
  453.     csp->break_sp = break_sp;
  454. }
  455.  
  456. /*
  457.  * Pop the control stack one element, and restore registers.
  458.  * extern_call must not be modified here, as it is used imediately after pop.
  459.  */
  460. static void pop_control_stack() {
  461. #ifdef DEBUG
  462.     if (csp == control_stack - 1)
  463.     fatal("Popped out of the control stack");
  464. #endif
  465.     current_object = csp->ob;
  466.     current_prog = csp->prog;
  467.     previous_ob = csp->prev_ob;
  468.     pc = csp->pc;
  469.     fp = csp->fp;
  470.     function_index_offset = csp->function_index_offset;
  471.     variable_index_offset = csp->variable_index_offset;
  472.     break_sp = csp->break_sp;
  473.     csp--;
  474. }
  475.  
  476. /*
  477.  * Push a pointer to a vector on the stack. Note that the reference count
  478.  * is incremented. Newly created vectors normally have a reference count
  479.  * initialized to 1.
  480.  */
  481. INLINE void push_vector(v)
  482.     struct vector *v;
  483. {
  484.     v->ref++;
  485.     sp++;
  486.     sp->type = T_POINTER;
  487.     sp->u.vec = v;
  488. }
  489.  
  490. /*
  491.  * Push a string on the stack that is already shared.
  492.  */
  493. static void INLINE push_shared_string(p)
  494.     char *p;
  495. {
  496.     sp++;
  497.     sp->type = T_STRING;
  498.     sp->u.string = p;
  499.     sp->string_type = STRING_SHARED;
  500. }
  501.  
  502. /*
  503.  * Push a string on the stack that is already malloced.
  504.  */
  505. static void INLINE push_malloced_string(p)
  506.     char *p;
  507. {
  508.     sp++;
  509.     sp->type = T_STRING;
  510.     sp->u.string = p;
  511.     sp->string_type = STRING_MALLOC;
  512. }
  513.  
  514. /*
  515.  * Push a string on the stack that is already constant.
  516.  */
  517. INLINE
  518. void push_constant_string(p)
  519.     char *p;
  520. {
  521.     sp++;
  522.     sp->type = T_STRING;
  523.     sp->u.string = p;
  524.     sp->string_type = STRING_CONSTANT;
  525. }
  526.  
  527. static void do_trace_call(funp)
  528.     struct function *funp;
  529. {
  530.     do_trace("Call direct ", funp->name, " ");
  531.     if (TRACEHB) {
  532.         if (TRACETST(TRACE_ARGS)) {
  533.             int i;
  534.             add_message(" with %d arguments: ", funp->num_arg);
  535.             for(i = funp->num_arg-1; i >= 0; i--) {
  536.                 print_svalue(&sp[-i]);
  537.                 add_message(" ");
  538.             }
  539.         }
  540.         add_message("\n");
  541.     }
  542. }
  543.  
  544. /*
  545.  * Argument is the function to execute. If it is defined by inheritance,
  546.  * then search for the reall definition, and return it.
  547.  * There is a number of arguments on the stack. Normalize them and initialize
  548.  * local variables, so that the called function is pleased.
  549.  */
  550. static struct function *setup_new_frame(funp)
  551.     struct function *funp;
  552. {
  553.     function_index_offset = 0;
  554.     variable_index_offset = 0;
  555.     while(funp->flags & NAME_INHERITED) {
  556.     function_index_offset +=
  557.         current_prog->inherit[funp->offset].function_index_offset;
  558.     variable_index_offset +=
  559.         current_prog->inherit[funp->offset].variable_index_offset;
  560.     current_prog =
  561.         current_prog->inherit[funp->offset].prog;
  562.     funp = ¤t_prog->functions[funp->function_index_offset];
  563.     }
  564.     /* Remove excessive arguments */
  565.     while(csp->num_local_variables > funp->num_arg) {
  566.     pop_stack();
  567.     csp->num_local_variables--;
  568.     }
  569.     /* Correct number of arguments and local variables */
  570.     while(csp->num_local_variables < funp->num_arg + funp->num_local) {
  571.     push_number(0);
  572.     csp->num_local_variables++;
  573.     }
  574.     tracedepth++;
  575.     if (TRACEP(TRACE_CALL)) {
  576.     do_trace_call(funp);
  577.     }
  578.     fp = sp - csp->num_local_variables + 1;
  579.     break_sp = (short*)(sp+1);
  580.     return funp;
  581. }
  582.  
  583. static void break_point()
  584. {
  585.     if (sp - fp - csp->num_local_variables + 1 != 0)
  586.     fatal("Bad stack pointer.\n");
  587. }
  588.  
  589. /* marion
  590.  * maintain a small and inefficient stack of error recovery context
  591.  * data structures.
  592.  */
  593. void push_pop_error_context (push) 
  594. int push;
  595. {
  596.     extern jmp_buf error_recovery_context;
  597.     extern int error_recovery_context_exists;
  598.     extern struct svalue catch_value;
  599.     static struct error_context_stack {
  600.     jmp_buf old_error_context;
  601.     int old_exists_flag;
  602.     struct control_stack *save_csp;
  603.     struct object *save_command_giver;
  604.     struct svalue *save_sp;
  605.     struct error_context_stack *next;
  606.     } *ecsp = 0, *p;
  607.  
  608.     if (push == 1) {
  609.     /*
  610.      * Save some global variables that must be restored separately
  611.      * after a longjmp. The stack will have to be manually popped all
  612.      * the way.
  613.      */
  614.     p = (struct error_context_stack *)xalloc (sizeof *p);
  615.     p->save_sp = sp;
  616.     p->save_csp = csp;    
  617.     p->save_command_giver = command_giver;
  618.     memcpy (
  619.         (char *)p->old_error_context,
  620.         (char *)error_recovery_context,
  621.         sizeof error_recovery_context);
  622.     p->old_exists_flag = error_recovery_context_exists;
  623.     p->next = ecsp;
  624.     ecsp = p;
  625.     } else {
  626.     if (p = ecsp) {
  627.         if (!push) {
  628. #ifdef DEBUG
  629.         if (csp != p->save_csp-1)
  630.             fatal("Catch: Lost track of csp");
  631.         if (command_giver != p->save_command_giver)
  632.             fatal("Catch: Lost track of command_giver");
  633. #endif
  634.         } else {
  635.         /*
  636.          * They did a throw() or error. That means that the control
  637.          * stack must be restored manually here.
  638.          */
  639.         csp = p->save_csp;    
  640.         pop_n_elems (sp - p->save_sp);
  641.         command_giver = p->save_command_giver;
  642.         }
  643.         memcpy (
  644.         (char *)error_recovery_context,
  645.         (char *)p->old_error_context,
  646.         sizeof error_recovery_context);
  647.         error_recovery_context_exists = p->old_exists_flag;
  648.         ecsp = p->next;
  649.         free ((char *)p);
  650.     } else fatal("Catch: error context stack underflow");
  651.     }
  652. }
  653.  
  654. static struct vector *append_vector(v, a)
  655. struct vector *v;
  656. struct svalue *a;
  657. {
  658.    int i;
  659.    struct vector *new;
  660.  
  661.    new = allocate_array(v->size+1);
  662.    for (i=0; i<v->size; ++i)
  663.       assign_svalue(&new->item[i], &v->item[i]);
  664.    assign_svalue(&new->item[i], a);
  665.    return new;
  666. }
  667.  
  668. static struct vector *prepend_vector(v, a)
  669. struct vector *v;
  670. struct svalue *a;
  671. {
  672.    int i;
  673.    struct vector *new;
  674.  
  675.    new = allocate_array(v->size+1);
  676.    assign_svalue(&new->item[0], a);
  677.    for (i=0; i<v->size; ++i)
  678.       assign_svalue(&new->item[i+1], &v->item[i]);
  679.    return new;
  680. }
  681.  
  682. /*
  683.  * When a vector is given as argument to an efun, all items has to be
  684.  * checked if there would be an destructed object.
  685.  * A bad problem currently is that a vector can contain another vector, so this
  686.  * should be tested too. But, there is currently no prevention against
  687.  * recursive vectors, which means that this can not be tested. Thus, the game
  688.  * may crash if a vector contains a vector that contains a destructed object
  689.  * and this top-most vector is used as an argument to an efun.
  690.  */
  691. /* The game won't crash when doing simple operations like assign_svalue
  692.  * on a destructed object. You have to watch out, of course, that you don't
  693.  * apply a function to it.
  694.  * to save space it is preferable that destructed objects are freed soon.
  695.  *   amylaar
  696.  */
  697. void check_for_destr(v)
  698.     struct vector *v;
  699. {
  700.     int i;
  701.  
  702.     for (i=0; i < v->size; i++) {
  703.     if (v->item[i].type != T_OBJECT)
  704.         continue;
  705.     if (!(v->item[i].u.ob->flags & O_DESTRUCTED))
  706.         continue;
  707.     assign_svalue(&v->item[i], &const0);
  708.     }
  709. }
  710.  
  711. /*
  712.  * Evaluate instructions at address 'p'. All program offsets are
  713.  * to current_prog->program. 'current_prog' must be setup before
  714.  * call of this function.
  715.  *
  716.  * There must not be destructed objects on the stack. The destruct_object()
  717.  * function will automatically remove all occurences. The effect is that
  718.  * all called efuns knows that they won't have destructed objects as
  719.  * arguments.
  720.  */
  721. #ifdef TRACE_CODE
  722. int previous_instruction[60];
  723. int stack_size[60];
  724. char *previous_pc[60];
  725. static int last;
  726. #endif
  727. static void eval_instruction(p)
  728.     char *p;
  729. {
  730.     struct object *ob;
  731.     int i, num_arg;
  732.     int instruction;
  733. #ifdef DEBUG
  734.     struct svalue *expected_stack;
  735. #endif
  736.     struct svalue *argp;
  737.  
  738.     /* Next F_RETURN at this level will return out of eval_instruction() */
  739.     csp->extern_call = 1;
  740.     pc = p;
  741. again:
  742.     instruction = EXTRACT_UCHAR(pc);
  743. #ifdef TRACE_CODE
  744.     previous_instruction[last] = instruction + F_OFFSET;
  745.     previous_pc[last] = pc;
  746.     stack_size[last] = sp - fp - csp->num_local_variables;
  747.     last = (last + 1) % (sizeof previous_instruction / sizeof (int));
  748. #endif
  749.     pc++;
  750.     if (current_object && current_object->user)
  751.     current_object->user->cost++;
  752.     eval_cost++;
  753.     if (eval_cost > MAX_COST) {
  754.     printf("eval_cost too big %d\n", eval_cost);
  755.         eval_cost = 0;
  756.     error("Too long evaluation. Execution aborted.\n");
  757.     }
  758.     /*
  759.      * Execute current instruction. Note that all functions callable
  760.      * from LPC must return a value. This does not apply to control
  761.      * instructions, like F_JUMP.
  762.      */
  763.     if (instrs[instruction].min_arg != instrs[instruction].max_arg) {
  764.     num_arg = EXTRACT_UCHAR(pc);
  765.     pc++;
  766.     if (num_arg > 0) {
  767.         if (instrs[instruction].type[0] != 0 &&
  768.         (instrs[instruction].type[0] & (sp-num_arg+1)->type) == 0) {
  769.         bad_arg(1, instruction + F_OFFSET);
  770.         }
  771.     }
  772.     if (num_arg > 1) {
  773.         if (instrs[instruction].type[1] != 0 &&
  774.         (instrs[instruction].type[1] & (sp-num_arg+2)->type) == 0) {
  775.         bad_arg(2, instruction + F_OFFSET);
  776.         }
  777.     }
  778.     } else {
  779.     num_arg = instrs[instruction].min_arg;
  780.     if (instrs[instruction].min_arg > 0) {
  781.         if (instrs[instruction].type[0] != 0 &&
  782.         (instrs[instruction].type[0] & (sp-num_arg+1)->type) == 0) {
  783.         bad_arg(1, instruction + F_OFFSET);
  784.         }
  785.     }
  786.     if (instrs[instruction].min_arg > 1) {
  787.         if (instrs[instruction].type[1] != 0 &&
  788.         (instrs[instruction].type[1] & (sp-num_arg+2)->type) == 0) {
  789.         bad_arg(2, instruction + F_OFFSET);
  790.         }
  791.     }
  792.     /*
  793.      * Safety measure. It is supposed that the evaluator knows
  794.      * the number of arguments.
  795.      */
  796.     num_arg = -1;
  797.     }
  798. #ifdef DEBUG
  799.     if (num_arg != -1) {
  800.     expected_stack = sp - num_arg + 1;
  801.     } else {
  802.     expected_stack = 0;
  803.     }
  804. #endif
  805.     instruction += F_OFFSET;
  806. #ifdef OPCPROF
  807.     if (instruction >= 0 && instruction < MAXOPC) opcount[instruction]++;
  808. #endif
  809.     /*
  810.      * Execute the instructions. The number of arguments are correct,
  811.      * and the type of the two first arguments are also correct.
  812.      */
  813.     if (TRACEP(TRACE_EXEC)) {
  814.     do_trace("Exec ", get_f_name(instruction), "\n");
  815.     }
  816.     switch(instruction) {
  817.     default:
  818.     fatal("Undefined instruction %s (%d)\n", get_f_name(instruction),
  819.           instruction);
  820.     /*NOTREACHED*/
  821.     CASE(F_REMOVE_SHADOW);
  822.     {
  823.         ob = current_object;
  824.         if (num_arg) { ob = sp->u.ob; pop_stack(); }
  825.         if (!ob || !ob->shadowing)
  826.            push_number(0);
  827.         else
  828.         {
  829.            if (ob->shadowed)
  830.               ob->shadowed->shadowing = ob->shadowing;
  831.            if (ob->shadowing)
  832.               ob->shadowing->shadowed = ob->shadowed;
  833.            ob->shadowing = ob->shadowed = 0;
  834.            push_object(ob, "F_REMOVE_SHADOW");
  835.         }
  836.         break;
  837.     }
  838.     CASE(F_REGEXP);
  839.       {
  840.     struct vector *v;
  841.     v = match_regexp((sp-1)->u.vec, sp->u.string);
  842.     pop_n_elems(2);
  843.     if (v == 0)
  844.         push_number(0);
  845.     else {
  846.         push_vector(v);
  847.         v->ref--;        /* Will make ref count == 1 */
  848.     }
  849.     break;
  850.     }
  851.     CASE(F_SHADOW);
  852.     {
  853.     struct svalue *ret;
  854.         struct object *top;
  855.  
  856.     top = ob = (sp-1)->u.ob;
  857.     if (sp->u.number == 0) {
  858.         ob = ob->shadowed;
  859.         pop_n_elems(2);
  860.             if (ob)
  861.            push_object(ob, "F_SHADOW");
  862.             else push_number(0);
  863.         break;
  864.      }
  865.     if (validate_shadowing(ob)) {
  866.        /*
  867.         * The shadow is entered first in the chain.
  868.         */
  869.         while (ob->shadowed)
  870.             ob = ob->shadowed;
  871.         current_object->shadowing = ob;
  872.         ob->shadowed = current_object;
  873.             current_object->shadowed = 0;
  874.         pop_n_elems(2);
  875.         push_object(top, "F_SHADOW");
  876.     }
  877.         else
  878.         {
  879.        pop_n_elems(2);
  880.        push_number(0);
  881.         }
  882.     break;
  883.     }
  884.     CASE(F_POP_VALUE);
  885.     pop_stack();
  886.     break;
  887.     CASE(F_DUP);
  888.     sp++;
  889.     assign_svalue_no_free(sp, sp-1);
  890.     break;
  891.     CASE(F_JUMP_WHEN_ZERO);
  892.     {
  893.     unsigned short offset;
  894.  
  895.     ((char *)&offset)[0] = pc[0];
  896.     ((char *)&offset)[1] = pc[1];
  897.     if (sp->type == T_NUMBER && sp->u.number == 0)
  898.         pc = current_prog->program + offset;
  899.     else
  900.         pc += 2;
  901.     pop_stack();
  902.     break;
  903.     }
  904.     CASE(F_JUMP);
  905.     {
  906.     unsigned short offset;
  907.  
  908.     ((char *)&offset)[0] = pc[0];
  909.     ((char *)&offset)[1] = pc[1];
  910.     pc = current_prog->program + offset;
  911.     break;
  912.     }
  913.     CASE(F_JUMP_WHEN_NON_ZERO);
  914.     {
  915.     unsigned short offset;
  916.  
  917.     ((char *)&offset)[0] = pc[0];
  918.     ((char *)&offset)[1] = pc[1];
  919.     if (sp->type == T_NUMBER && sp->u.number == 0)
  920.         pc += 2;
  921.     else
  922.         pc = current_prog->program + offset;
  923.     pop_stack();
  924.     break;
  925.     }
  926.     CASE(F_INDIRECT);
  927. #ifdef DEBUG
  928.     if (sp->type != T_LVALUE)
  929.         fatal("Bad type to F_INDIRECT\n");
  930. #endif
  931.     assign_svalue(sp, sp->u.lvalue);
  932.     /*
  933.      * Fetch value of a variable. It is possible that it is a variable
  934.      * that points to a destructed object. In that case, it has to
  935.      * be replaced by 0.
  936.      */
  937.     if (sp->type == T_OBJECT && (sp->u.ob->flags & O_DESTRUCTED)) {
  938.         free_svalue(sp, "F_INDIRECT");
  939.             *sp = const0;
  940.     }
  941.     break;
  942.     CASE(F_IDENTIFIER);
  943.     sp++;
  944.     assign_svalue_no_free(sp, find_value((int)(EXTRACT_UCHAR(pc) +
  945.                            variable_index_offset)));
  946.     pc++;
  947.     /*
  948.      * Fetch value of a variable. It is possible that it is a variable
  949.      * that points to a destructed object. In that case, it has to
  950.      * be replaced by 0.
  951.      */
  952.     if (sp->type == T_OBJECT && (sp->u.ob->flags & O_DESTRUCTED)) {
  953.         free_svalue(sp, "F_ID");
  954.             *sp = const0;
  955.     }
  956.     break;
  957.     CASE(F_PUSH_IDENTIFIER_LVALUE);
  958.     sp++;
  959.     sp->type = T_LVALUE;
  960.     sp->u.lvalue = find_value((int)(EXTRACT_UCHAR(pc) +
  961.                     variable_index_offset));
  962.     pc++;
  963.     break;
  964.     CASE(F_PUSH_INDEXED_LVALUE);
  965.     push_indexed_lvalue();
  966.     break;
  967.     CASE(F_INDEX_INSTR);
  968.     push_indexed_lvalue();
  969.     assign_svalue_no_free(sp, sp->u.lvalue);
  970.     /*
  971.      * Fetch value of a variable. It is possible that it is a variable
  972.      * that points to a destructed object. In that case, it has to
  973.      * be replaced by 0.
  974.      */
  975.     if (sp->type == T_OBJECT && (sp->u.ob->flags & O_DESTRUCTED)) {
  976.         free_svalue(sp, "F_INDEX_INSTR");
  977.         sp->type = T_NUMBER;
  978.         sp->u.number = 0;
  979.     }
  980.     break;
  981.     CASE(F_LOCAL_NAME);
  982.     sp++;
  983.     assign_svalue_no_free(sp, fp + EXTRACT_UCHAR(pc));
  984.     pc++;
  985.     /*
  986.      * Fetch value of a variable. It is possible that it is a variable
  987.      * that points to a destructed object. In that case, it has to
  988.      * be replaced by 0.
  989.      */
  990.     if (sp->type == T_OBJECT && (sp->u.ob->flags & O_DESTRUCTED)) {
  991.         free_svalue(sp, "F_LOCAL_NAME");
  992.         *sp = const0;
  993.     }
  994.     break;
  995.     CASE(F_PUSH_LOCAL_VARIABLE_LVALUE);
  996.     sp++;
  997.     sp->type = T_LVALUE;
  998.     sp->u.lvalue = fp + EXTRACT_UCHAR(pc);
  999.     pc++;
  1000.     break;
  1001.     CASE(F_RETURN);
  1002.     {
  1003.     struct svalue sv;
  1004.  
  1005.     sv = *sp--;
  1006.     /*
  1007.      * Deallocate frame and return.
  1008.      */
  1009.     for (i=0; i < csp->num_local_variables; i++)
  1010.         pop_stack();
  1011.     sp++;
  1012. #ifdef DEBUG
  1013.     if (sp != fp)
  1014.         fatal("Bad stack at F_RETURN\n"); /* marion */
  1015. #endif
  1016.     *sp = sv;    /* This way, the same ref counts are maintained */
  1017.     pop_control_stack();
  1018.     tracedepth--;
  1019.     if (TRACEP(TRACE_RETURN)) {
  1020.         do_trace("Return", "", "");
  1021.         if (TRACEHB) {
  1022.         if (TRACETST(TRACE_ARGS)) {
  1023.             add_message(" with value: ");
  1024.             print_svalue(sp);
  1025.         }
  1026.         add_message("\n");
  1027.         }
  1028.     }
  1029.     if (csp[1].extern_call)    /* The control stack was popped just before */
  1030.         return;
  1031.     break;
  1032.     }
  1033.     CASE(F_BREAK_POINT);
  1034.     break_point();    /* generated by lang.y when -d. Will check stack. */
  1035.     break;
  1036.     CASE(F_CHECK_REF);
  1037.     {
  1038.        int a = -1;
  1039.        if (num_arg == 2)
  1040.        {
  1041.           if ((sp-1)->type == T_OBJECT)
  1042.              a = (sp-1)->u.ob->ref;
  1043.        } 
  1044.        else if (sp->type == T_OBJECT)
  1045.           a = sp->u.ob->prog->ref;
  1046.        else if (sp->type == T_POINTER)
  1047.           a = sp->u.vec->ref;
  1048.        pop_n_elems(num_arg);
  1049.        push_number(a);
  1050.        break;
  1051.     }
  1052.     CASE(F_CLONE_OBJECT);
  1053.     ob = clone_object(sp->u.string);
  1054.     pop_stack();
  1055.     if (ob) {
  1056.             push_object(ob, "F_CLONE_OBJECT");
  1057.     } else {
  1058.         push_number(0);
  1059.     }
  1060.     break;
  1061.     CASE(F_AGGREGATE);
  1062.     {
  1063.     struct vector *v;
  1064.     unsigned short num;
  1065.  
  1066.     ((char *)&num)[0] = pc[0];
  1067.     ((char *)&num)[1] = pc[1];
  1068.     pc += 2;
  1069.     v = allocate_array((int)num);
  1070.     for (i=0; i < num; i++)
  1071.         assign_svalue_no_free(&v->item[i], sp + i - num + 1);
  1072.     pop_n_elems((int)num);
  1073.     sp++;
  1074.     sp->type = T_POINTER;
  1075.     sp->u.vec = v;        /* Ref count already initialized */
  1076.     break;
  1077.     }
  1078.     CASE(F_TAIL);
  1079.     if (tail(sp->u.string))
  1080.         assign_svalue(sp, &const1);
  1081.     else
  1082.         assign_svalue(sp, &const0);
  1083.     break;
  1084.     CASE(F_CALL_FUNCTION_BY_ADDRESS);
  1085.     {
  1086.     unsigned short func_index;
  1087.     struct function *funp;
  1088.  
  1089.     ((char *)&func_index)[0] = pc[0];
  1090.     ((char *)&func_index)[1] = pc[1];
  1091.     pc += 2;
  1092.     func_index += function_index_offset;
  1093.     /*
  1094.      * Find the function in the function table. As the function may have
  1095.      * been redefined by inheritance, we must look in the last table,
  1096.      * which is pointed to by current_object.
  1097.      */
  1098. #ifdef DEBUG
  1099.     if (func_index >= current_object->prog->num_functions)
  1100.         fatal("Illegal function index\n");
  1101. #endif
  1102.  
  1103.     /* NOT current_prog, which can be an inherited object. */
  1104.     funp = ¤t_object->prog->functions[func_index];
  1105.  
  1106.     if (funp->flags & NAME_UNDEFINED)
  1107.         error("Undefined function: %s\n", funp->name);
  1108.     /* Save all important global stack machine registers */
  1109.     push_control_stack(funp);    /* return pc is adjusted later */
  1110.  
  1111.     /* This assigment must be done after push_control_stack() */
  1112.     current_prog = current_object->prog;
  1113.     /*
  1114.      * If it is an inherited function, search for the real
  1115.      * definition.
  1116.      */
  1117.     csp->num_local_variables = EXTRACT_UCHAR(pc);
  1118.     pc++;
  1119.     funp = setup_new_frame(funp);
  1120.     csp->pc = pc;    /* The corrected return address */
  1121.     pc = current_prog->program + funp->offset;
  1122.     csp->extern_call = 0;
  1123.     break;
  1124.     }
  1125.     CASE(F_SAVE_OBJECT);
  1126.     save_object(current_object, sp->u.string);
  1127.     /* The argument is returned */
  1128.     break;
  1129.     CASE(F_FIND_OBJECT);
  1130.     ob = find_object2(sp->u.string);
  1131.     pop_stack();
  1132.     if (ob)
  1133.         push_object(ob, "F_FIND_OBJECT");
  1134.     else
  1135.         push_number(0);
  1136.     break;
  1137.     CASE(F_FIND_PLAYER);
  1138.     ob = find_living_object(sp->u.string, 1);
  1139.     pop_stack();
  1140.     if (!ob)
  1141.         push_number(0);
  1142.     else
  1143.         push_object(ob, "F_FIND_PLAYER");
  1144.     break;
  1145.     CASE(F_WRITE_FILE);
  1146.     i = write_file((sp-1)->u.string, sp->u.string);
  1147.         pop_n_elems(2);
  1148.         push_number(i);
  1149.     break;    /* Return first argument */
  1150.     CASE(F_READ_BYTES);
  1151.     {
  1152.     char *str;
  1153.     struct svalue *arg = sp- num_arg + 1;
  1154.     int start = 0, len = 0;
  1155.  
  1156.     if (num_arg > 1)
  1157.         start = arg[1].u.number;
  1158.     if (num_arg == 3) {
  1159.         if (arg[2].type != T_NUMBER)
  1160.         bad_arg(2, instruction);
  1161.         len = arg[2].u.number;
  1162.     }
  1163.  
  1164.     str = read_bytes(arg[0].u.string, start, len);
  1165.     pop_n_elems(num_arg);
  1166.     if (str == 0)
  1167.         push_number(0);
  1168.     else {
  1169.         push_string(str, STRING_MALLOC);
  1170.         free(str);
  1171.     }
  1172.     break;
  1173.     }
  1174.     CASE(F_WRITE_BYTES);
  1175.     i = write_bytes((sp-2)->u.string, (sp-1)->u.number, sp->u.string);
  1176.     pop_n_elems(3);
  1177.     push_number(i);
  1178.     break;
  1179.     CASE(F_FILE_SIZE);
  1180.     i = file_size(sp->u.string);
  1181.     pop_stack();
  1182.     push_number(i);
  1183.     break;
  1184.     CASE(F_FIND_LIVING);
  1185.     ob = find_living_object(sp->u.string, 0);
  1186.     pop_stack();
  1187.     if (!ob)
  1188.         push_number(0);
  1189.     else
  1190.         push_object(ob, "F_FIND_LIVING");
  1191.     break;
  1192.     CASE(F_TELL_OBJECT);
  1193.     tell_object((sp-1)->u.ob, sp->u.string);
  1194.     pop_stack();    /* Return first argument */
  1195.     break;
  1196.     CASE(F_RESTORE_OBJECT);
  1197.     i = restore_object(current_object, sp->u.string);
  1198.     pop_stack();
  1199.     push_number(i);
  1200.     break;
  1201.     CASE(F_THIS_PLAYER);
  1202.         if (num_arg && current_interactive &&
  1203.            !(current_interactive->flags & O_DESTRUCTED) )
  1204.             push_object(current_interactive, "F_THIS_PLAYER"); 
  1205.     else if (command_giver && !(command_giver->flags & O_DESTRUCTED))
  1206.         push_object(command_giver, "F_THIS_PLAYER");
  1207.     else
  1208.         push_number(0);
  1209.     break;
  1210.     CASE(F_FIRST_INVENTORY);
  1211.     ob = first_inventory(sp);
  1212.     pop_stack();
  1213.     if (ob)
  1214.         push_object(ob, "F_FIRST_INVENTORY");
  1215.     else
  1216.         push_number(0);
  1217.     break;
  1218.     CASE(F_LIVING);
  1219.     if (sp->u.ob->flags & O_ENABLE_COMMANDS)
  1220.         assign_svalue(sp, &const1);
  1221.     else
  1222.         assign_svalue(sp, &const0);
  1223.     break;
  1224. #ifdef FGETUID
  1225.     CASE(F_GETUID);
  1226.     ob = sp->u.ob;
  1227. #ifdef DEBUG
  1228.     if (ob->user == 0)
  1229.         fatal("User is null pointer\n");
  1230. #endif
  1231.     {   char *tmp;
  1232.         tmp = ob->user->name;
  1233.         pop_stack();
  1234.         push_string(tmp, STRING_CONSTANT);
  1235.     }
  1236.     break;
  1237. #endif F_GETUID
  1238. #ifdef F_GETEUID
  1239.     CASE(F_GETEUID);
  1240.     /*
  1241.      * Are there any reasons to support this one in -o mode ?
  1242.      */
  1243.     ob = sp->u.ob;
  1244.  
  1245.     if (ob->eff_user) {
  1246.         char *tmp;
  1247.         tmp = ob->eff_user->name;
  1248.         pop_stack();
  1249.         push_string(tmp, STRING_CONSTANT);
  1250.     }
  1251.     else {
  1252.         pop_stack();
  1253.         push_number(0);
  1254.     }
  1255.     break;
  1256. #endif /* F_GETEUID */
  1257. #ifdef F_EXPORT_UID
  1258.     CASE(F_EXPORT_UID);
  1259.     if (current_object->eff_user==0)
  1260.         error("Illegal to export uid.\n");
  1261.     ob = sp->u.ob;
  1262.     if (ob->eff_user)    /* Only allowed to export when null */
  1263.         break;
  1264.     ob->user = current_object->eff_user;
  1265.     break;
  1266. #endif /* F_EXPORT_UID */
  1267. #ifdef F_SETEUID
  1268.     CASE(F_SETEUID);
  1269.     {
  1270.     struct svalue *ret;
  1271.  
  1272.     if (sp->type == T_NUMBER) {
  1273.         if (sp->u.number != 0)
  1274.         bad_arg(1, F_SETEUID);
  1275.         current_object->eff_user = 0;
  1276.         pop_stack();
  1277.         push_number(1);
  1278.         break;
  1279.     }
  1280.     argp = sp;
  1281.     if (argp->type != T_STRING)
  1282.         bad_arg(1, F_SETEUID);
  1283.     push_object(current_object, "F_SETEUID");
  1284.     push_string(argp->u.string, STRING_CONSTANT);
  1285.     ret = apply_master_ob("valid_seteuid", 2);
  1286.     if (ret == 0 || ret->type != T_NUMBER || ret->u.number != 1) {
  1287.         pop_stack();
  1288.         push_number(0);
  1289.         break;
  1290.     }
  1291.     current_object->eff_user = add_name(argp->u.string);
  1292.     pop_stack();
  1293.     push_number(1);
  1294.     break;
  1295.     }
  1296. #endif
  1297. #ifdef F_CREATOR
  1298.     CASE(F_CREATOR);
  1299.     ob = sp->u.ob;
  1300.     if (ob->user == 0) {
  1301.         assign_svalue(sp, &const0);
  1302.     } else {
  1303.         pop_stack();
  1304.         push_string(ob->user->name, STRING_CONSTANT);
  1305.     }
  1306.     break;
  1307. #endif
  1308.     CASE(F_SHUTDOWN);
  1309.     {
  1310.         extern struct object *master_ob;
  1311.         assert_master_ob_loaded();
  1312.         if (current_object != master_ob)
  1313.             error("shutdown() can only be called from master.c\n");
  1314.     startshutdowngame();
  1315.     push_number(0);
  1316.     break;
  1317.     }
  1318.     CASE(F_EXPLODE);
  1319.     {
  1320.     struct vector *v;
  1321.     v = explode_string((sp-1)->u.string, sp->u.string);
  1322.     pop_n_elems(2);
  1323.     if (v) {
  1324.         push_vector(v);    /* This will make ref count == 2 */
  1325.         v->ref--;
  1326.     } else {
  1327.         push_number(0);
  1328.     }
  1329.     break;
  1330.     }
  1331.     CASE(F_FILTER_ARRAY);
  1332.     {
  1333.     struct vector *v;
  1334.     struct svalue *arg;
  1335.  
  1336.     arg = sp - num_arg + 1; ob = 0;
  1337.  
  1338.         if (arg[2].type == T_OBJECT)
  1339.             ob = arg[2].u.ob;
  1340.         else if (arg[2].type == T_STRING)
  1341.             ob = find_object(arg[2].u.string); 
  1342.            
  1343.         if (!ob)
  1344.         error("Bad type argument 3 to filter_array()\n");
  1345.  
  1346.     if (arg[0].type == T_POINTER) {
  1347.         check_for_destr(arg[0].u.vec);
  1348.         v = filter(arg[0].u.vec, arg[1].u.string, ob,
  1349.                num_arg > 3 ? sp : (struct svalue *)0); 
  1350.     } else {
  1351.         v = 0;
  1352.     }
  1353.     
  1354.     pop_n_elems(num_arg);
  1355.     if (v) {
  1356.         push_vector(v); /* This will make ref count == 2 */
  1357.         v->ref--;
  1358.     } else {
  1359.         push_number(0);
  1360.     }
  1361.     break;
  1362.     }
  1363.     CASE(F_SET_BIT);
  1364.     {
  1365.     char *str;
  1366.     int len, old_len, ind;
  1367.  
  1368.     if (sp->u.number > MAX_BITS)
  1369.         error("set_bit: too big bit number: %d\n", sp->u.number);
  1370.     len = strlen((sp-1)->u.string);
  1371.     old_len = len;
  1372.     ind = sp->u.number/6;
  1373.     if (ind >= len)
  1374.         len = ind + 1;
  1375.     str = xalloc(len+1);
  1376.     str[len] = '\0';
  1377.     if (old_len)
  1378.         memcpy(str, (sp-1)->u.string, old_len);
  1379.     if (len > old_len)
  1380.         memset(str + old_len, ' ', len - old_len);
  1381.     if (str[ind] > 0x3f + ' ' || str[ind] < ' ')
  1382.         error("Illegal bit pattern in set_bit character %d\n", ind);
  1383.     str[ind] = (str[ind] - ' ' | 1 << sp->u.number % 6) + ' ';
  1384.     pop_n_elems(2);
  1385.     sp++;
  1386.     sp->u.string = str;
  1387.     sp->string_type = STRING_MALLOC;
  1388.     sp->type = T_STRING;
  1389.     break;
  1390.     }
  1391.     CASE(F_CLEAR_BIT);
  1392.     {
  1393.     char *str;
  1394.     int len, ind;
  1395.  
  1396.     if (sp->u.number > MAX_BITS)
  1397.         error("clear_bit: too big bit number: %d\n", sp->u.number);
  1398.     len = strlen((sp-1)->u.string);
  1399.     ind = sp->u.number/6;
  1400.     if (ind >= len) {
  1401.         /* Return first argument unmodified ! */
  1402.         pop_stack();
  1403.         break;
  1404.     }
  1405.     str = xalloc(len+1);
  1406.     memcpy(str, (sp-1)->u.string, len+1);    /* Including null byte */
  1407.     if (str[ind] > 0x3f + ' ' || str[ind] < ' ')
  1408.         error("Illegal bit pattern in clear_bit character %d\n", ind);
  1409.     str[ind] = (str[ind] - ' ' & ~(1 << sp->u.number % 6)) + ' ';
  1410.     pop_n_elems(2);
  1411.     sp++;
  1412.     sp->type = T_STRING;
  1413.     sp->string_type = STRING_MALLOC;
  1414.     sp->u.string = str;
  1415.     break;
  1416.     }
  1417.     CASE(F_TEST_BIT);
  1418.     {
  1419.     int len;
  1420.  
  1421.     len = strlen((sp-1)->u.string);
  1422.     if (sp->u.number/6 >= len) {
  1423.         pop_n_elems(2);
  1424.         push_number(0);
  1425.         break;
  1426.     }
  1427.     if ((sp-1)->u.string[sp->u.number/6] - ' ' & 1 << sp->u.number % 6) {
  1428.         pop_n_elems(2);
  1429.         push_number(1);
  1430.     } else {
  1431.         pop_n_elems(2);
  1432.         push_number(0);
  1433.     }
  1434.     break;
  1435.     }
  1436.     CASE(F_QUERY_LOAD_AVERAGE);
  1437.     push_string(query_load_av(), STRING_SHARED); /**MALLOC**/
  1438.     break;
  1439.     CASE(F_CATCH);
  1440.     /*
  1441.      * Catch/Throw - catch errors in system or other peoples routines.
  1442.      */
  1443.     {
  1444.     extern jmp_buf error_recovery_context;
  1445.     extern int error_recovery_context_exists;
  1446.     extern struct svalue catch_value;
  1447.     unsigned short new_pc_offset;
  1448.  
  1449.     /*
  1450.      * Compute address of next instruction after the CATCH statement.
  1451.      */
  1452.     ((char *)&new_pc_offset)[0] = pc[0];
  1453.     ((char *)&new_pc_offset)[1] = pc[1];
  1454.     pc += 2;
  1455.  
  1456.     push_control_stack((struct function *)0);
  1457.     csp->num_local_variables = 0;    /* No extra variables */
  1458.     csp->pc = current_prog->program + new_pc_offset;
  1459.     csp->num_local_variables = (csp-1)->num_local_variables; /* marion */
  1460.     /*
  1461.      * Save some global variables that must be restored separately
  1462.      * after a longjmp. The stack will have to be manually popped all
  1463.      * the way.
  1464.      */
  1465.     push_pop_error_context (1);
  1466.     
  1467.     /* signal catch OK - print no err msg */
  1468.        error_recovery_context_exists = 2;
  1469.     if (setjmp(error_recovery_context)) {
  1470.         /*
  1471.          * They did a throw() or error. That means that the control
  1472.          * stack must be restored manually here.
  1473.          * Restore the value of expected_stack also. It is always 0
  1474.          * for catch().
  1475.          */
  1476. #ifdef DEBUG
  1477.         expected_stack = 0;
  1478. #endif
  1479.         push_pop_error_context (-1);
  1480.         pop_control_stack();
  1481.         assign_svalue_no_free(++sp, &catch_value);
  1482.     }
  1483.  
  1484.     /* next error will return 1 by default */
  1485.     assign_svalue(&catch_value, &const1);
  1486.     break;
  1487.     }
  1488.     CASE(F_THROW);
  1489.     /* marion
  1490.      * the return from catch is now done by a 0 throw
  1491.      */
  1492.     assign_svalue(&catch_value, sp--);
  1493.     if (catch_value.type == T_NUMBER && catch_value.u.number == 0) {
  1494.         /* We come here when no longjmp() was executed. */
  1495.         pop_control_stack();
  1496.         push_pop_error_context (0);
  1497.         push_number(0);
  1498.     } else throw_error(); /* do the longjump, with extra checks... */
  1499.     break;
  1500.     CASE(F_NOTIFY_FAIL);
  1501.     set_notify_fail_message(sp->u.string);
  1502.     /* Return the argument */
  1503.     break;
  1504.     CASE(F_QUERY_IDLE);
  1505.     i = query_idle(sp->u.ob);
  1506.     pop_stack();
  1507.     push_number(i);
  1508.     break;
  1509.     CASE(F_IMPLODE);
  1510.     {
  1511.     char *str;
  1512.     check_for_destr((sp-1)->u.vec);
  1513.     str = implode_string((sp-1)->u.vec, sp->u.string);
  1514.     pop_n_elems(2);
  1515.     if (str) {
  1516.         sp++;
  1517.         sp->type = T_STRING;
  1518.         sp->string_type = STRING_SHARED;
  1519.         sp->u.string = make_shared_string(str); /**MALLOC**/
  1520.             free(str);
  1521.     } else {
  1522.         push_number(0);
  1523.     }
  1524.     break;
  1525.     }
  1526.     CASE(F_QUERY_SNOOP);
  1527.     {
  1528.     struct svalue *arg1;
  1529.         extern struct object *master_ob;
  1530.  
  1531.     if (command_giver == 0 || sp->u.ob->interactive == 0) {
  1532.         assign_svalue(sp, &const0);
  1533.         break;
  1534.     }
  1535.  
  1536. #ifdef COMPAT_MODE
  1537.     arg1 = sapply("query_level", command_giver, 0);
  1538.     if (arg1 == 0 || arg1->type != T_NUMBER || 
  1539.             arg1->u.number < QUERY_SNOOP_LEVEL) 
  1540.         {
  1541.         assign_svalue(sp, &const0);
  1542.         break;
  1543.     } 
  1544.     ob = query_snoop(sp->u.ob);
  1545. #else
  1546.     assert_master_ob_loaded();
  1547.     if (current_object == master_ob)
  1548.         ob = query_snoop(sp->u.ob);
  1549.     else
  1550.         ob = 0;
  1551. #endif
  1552.         pop_stack();
  1553.     if (ob)
  1554.         push_object(ob, "F_QUERY_SNOOP");
  1555.     else
  1556.         push_number(0);
  1557.     break;
  1558.     }
  1559.     CASE(F_QUERY_IP_NUMBER);
  1560.     CASE(F_QUERY_IP_NAME);
  1561.     {
  1562.     extern char *query_ip_number PROT((struct object *));
  1563.     extern char *query_ip_name PROT((struct object *));
  1564.     char *tmp;
  1565.  
  1566.     if (num_arg == 1 && sp->type != T_OBJECT)
  1567.         error("Bad optional argument to query_ip_number()\n");
  1568.         if (instruction == F_QUERY_IP_NAME)
  1569.         tmp = query_ip_name(num_arg ? sp->u.ob : 0);
  1570.     else
  1571.         tmp = query_ip_number(num_arg ? sp->u.ob : 0);
  1572.        
  1573.     if (num_arg)
  1574.         pop_stack();
  1575.     if (tmp == 0)
  1576.         push_number(0);
  1577.     else
  1578.         push_string(tmp, STRING_SHARED); /**MALLOC**/
  1579.     break;
  1580.     }
  1581.     CASE(F_QUERY_HOST_NAME);
  1582.     {
  1583.     extern char *query_host_name();
  1584.     char *tmp;
  1585.  
  1586.     tmp = query_host_name();
  1587.     if (tmp)
  1588.         push_string(tmp, STRING_CONSTANT);
  1589.     else
  1590.         push_number(0);
  1591.     break;
  1592.     }
  1593.     CASE(F_NEXT_INVENTORY);
  1594.     ob = sp->u.ob;
  1595.     pop_stack();
  1596.     if (ob->next_inv)
  1597.         push_object(ob->next_inv, "F_NEXT_INVENTORY");
  1598.     else
  1599.         push_number(0);
  1600.     break;
  1601.     CASE(F_ALL_INVENTORY);
  1602.     case F_CONTENTS:
  1603.     {
  1604.     struct vector *vec;
  1605.         struct object *ob = current_object;
  1606.  
  1607.         if (num_arg) 
  1608.         {
  1609.             if (sp->type == T_OBJECT)
  1610.                ob = sp->u.ob;
  1611.             else 
  1612.                ob = find_object(sp->u.string);
  1613.             pop_stack();
  1614.             if (!ob) 
  1615.             {
  1616.                push_number(0); 
  1617.                break;
  1618.             } 
  1619.         }
  1620.                  
  1621.     vec = all_inventory(ob);
  1622.     if (vec == 0) {
  1623.         push_number(0);
  1624.     } else {
  1625.         push_vector(vec); /* This will make ref count == 2 */
  1626.         vec->ref--;
  1627.     }
  1628.     break;
  1629.     }
  1630.     CASE(F_DEEP_INVENTORY);
  1631.     {
  1632.     struct vector *vec;
  1633.     vec = deep_inventory(sp->u.ob, 0);
  1634.     free_svalue(sp, "F_DEEP_INVENTORY");
  1635.     sp->type = T_POINTER;
  1636.     sp->u.vec = vec;
  1637.     break;
  1638.     }
  1639.     CASE(F_ENVIRONMENT);
  1640.     if (num_arg) {
  1641.         ob = environment(sp);
  1642.         pop_stack();
  1643.     } else if (!(current_object->flags & O_DESTRUCTED)) {
  1644.         ob = current_object->super;
  1645.     } else
  1646.         ob = 0;
  1647.     if (ob)
  1648.         {
  1649.         push_object(ob, "F_ENVIRONMENT");
  1650.         }
  1651.     else
  1652.         push_number(0);
  1653.     break;
  1654.     CASE(F_THIS_OBJECT);
  1655.     push_object(current_object, "F_THIS_OBJECT");
  1656.     break;
  1657.     CASE(F_PREVIOUS_OBJECT);
  1658.     if (previous_ob == 0 || (previous_ob->flags & O_DESTRUCTED))
  1659.         push_number(0);
  1660.     else
  1661.         push_object(previous_ob, "F_PREVIOUS_OBJECT");
  1662.     break;
  1663.     CASE(F_LOCALCMD);
  1664.     print_local_commands();
  1665.     push_number(0);
  1666.     break;
  1667.     CASE(F_SWAP);
  1668.     (void)swap(sp->u.ob);
  1669.     break;
  1670.     CASE(F_TRACE);
  1671.     {
  1672.         int ot = -1;
  1673.         if (command_giver && command_giver->interactive) {
  1674.             struct svalue *arg;
  1675.         push_constant_string("trace");
  1676.         arg = apply_master_ob("query_player_level", 1);
  1677.         if (arg && (arg->type != T_NUMBER || arg->u.number != 0)) {
  1678.             ot = command_giver->interactive->trace_level;
  1679.             command_giver->interactive->trace_level = sp->u.number;
  1680.         }
  1681.     }
  1682.         pop_stack();
  1683.         push_number(ot);
  1684.     }
  1685.     break;
  1686.     CASE(F_TRACEPREFIX);
  1687.     {
  1688.         char *old = 0;
  1689.  
  1690.         if (command_giver && command_giver->interactive) {
  1691.         struct svalue *arg;
  1692.         push_constant_string("trace");
  1693.         arg = apply_master_ob("query_player_level",1);
  1694.         if (arg && (arg->type != T_NUMBER || arg->u.number)) {
  1695.             old = command_giver->interactive->trace_prefix;
  1696.             if (sp->type == T_STRING) {
  1697.                 command_giver->interactive->trace_prefix = 
  1698.                 make_shared_string(sp->u.string);
  1699.                     } else
  1700.                 command_giver->interactive->trace_prefix = 0;
  1701.         }
  1702.         }
  1703.         pop_stack();
  1704.         if (old) {
  1705.         push_string(old, STRING_SHARED);   /* Will incr ref count */
  1706.         free_string(old);
  1707.         } else {
  1708.         push_number(0);
  1709.         }
  1710.     }
  1711.         break;
  1712.     CASE(F_TIME);
  1713.     push_number(current_time);
  1714.     break;
  1715.     CASE(F_WIZLIST);
  1716.     if (num_arg) {
  1717.         wizlist(sp->u.string);
  1718.     } else {
  1719.         wizlist((char *)0);
  1720.         push_number(0);
  1721.     }
  1722.     break;
  1723. #ifdef F_TRANSFER
  1724.     CASE(F_TRANSFER);
  1725.     {
  1726.     struct object *dest;
  1727.  
  1728.     if (sp->type == T_STRING) {
  1729.         dest = find_object(sp->u.string);
  1730.         if (dest == 0)
  1731.         error("Object not found.\n");
  1732.     } else {
  1733.         dest = sp->u.ob;
  1734.     }
  1735.     i = transfer_object((sp-1)->u.ob, dest);
  1736.     pop_n_elems(2);
  1737.     push_number(i);
  1738.     break;
  1739.     }
  1740. #endif
  1741.     CASE(F_ADD_WORTH);
  1742.     if (strncmp(current_object->name, "obj/", 4) != 0 &&
  1743.         strncmp(current_object->name, "std/", 4) != 0 &&
  1744.         strncmp(current_object->name, "room/", 5) != 0)
  1745.         error("Illegal call of add_worth.\n");
  1746.     if (num_arg == 2) {
  1747.         if (sp->u.ob->user)
  1748.         sp->u.ob->user->total_worth += (sp-1)->u.number;
  1749.         pop_stack();
  1750.     } else {
  1751.         if (previous_ob == 0)
  1752.         break;
  1753.         if (previous_ob->user)
  1754.         previous_ob->user->total_worth += sp->u.number;
  1755.     }
  1756.     break;
  1757.     CASE(F_ADD);
  1758.     {
  1759.        struct svalue ret;
  1760.        switch((sp-1)->type)
  1761.        {
  1762.           case T_STRING:
  1763.           {
  1764.              switch(sp->type)
  1765.              {
  1766.                 case T_STRING:
  1767.                 {
  1768.                    char *res;
  1769.                res=xalloc(strlen((sp-1)->u.string)+strlen(sp->u.string)+1);
  1770.                (void)strcpy(res, (sp-1)->u.string);
  1771.                (void)strcat(res, sp->u.string);
  1772.                    ret.type = T_STRING;
  1773.                    ret.string_type = STRING_SHARED;
  1774.                    ret.u.string = make_shared_string(res);
  1775.                    free(res);
  1776.                    break;
  1777.                 } 
  1778.                 case T_NUMBER:
  1779.                 {
  1780.                char buff[20];
  1781.                char *res;
  1782.                sprintf(buff, "%d", sp->u.number);
  1783.                res = xalloc(strlen((sp-1)->u.string) + strlen(buff) + 1);
  1784.                strcpy(res, (sp-1)->u.string);
  1785.                strcat(res, buff);
  1786.                    ret.type = T_STRING;
  1787.                    ret.string_type = STRING_SHARED;
  1788.                    ret.u.string = make_shared_string(res);
  1789.                    free(res);
  1790.                    break;
  1791.                 }
  1792.                 case T_POINTER:
  1793.                    ret.type = T_POINTER;
  1794.                    ret.u.vec = prepend_vector(sp->u.vec, sp-1);
  1795.                    break;
  1796.                 default: error("Bad type argument to +. %d %d\n", 
  1797.                    (sp-1)->type, sp->type);
  1798.              }
  1799.              break;
  1800.           } 
  1801.           case T_NUMBER:
  1802.           {
  1803.              ret.type = sp->type;
  1804.              switch(sp->type)
  1805.              {
  1806.                 case T_NUMBER:
  1807.                    ret.u.number = sp->u.number + (sp-1)->u.number;
  1808.                    break;
  1809.                 case T_STRING:
  1810.                 {
  1811.                char buff[20], *res;
  1812.                sprintf(buff, "%d", (sp-1)->u.number);
  1813.                res = xalloc(strlen(sp->u.string) + strlen(buff) + 1);
  1814.                strcpy(res, buff);
  1815.                strcat(res, sp->u.string);
  1816.                    ret.string_type = STRING_SHARED;
  1817.                    ret.u.string = make_shared_string(res);
  1818.                    free(res);
  1819.                    break;
  1820.                 }
  1821.                 case T_POINTER:
  1822.                    ret.u.vec = prepend_vector(sp->u.vec, sp-1);
  1823.                    break;
  1824.                 default: error("Bad type argument to +. %d %d\n", 
  1825.                    (sp-1)->type, sp->type);
  1826.              }
  1827.              break;
  1828.           }
  1829.           case T_POINTER:
  1830.           {
  1831.              ret.type = T_POINTER;
  1832.              switch(sp->type)
  1833.              {
  1834.                 case T_POINTER:
  1835.                    ret.u.vec = add_array((sp-1)->u.vec, sp->u.vec);
  1836.                    break;
  1837.                 case T_NUMBER:
  1838.                 case T_STRING:
  1839.                    ret.u.vec = append_vector((sp-1)->u.vec, sp);
  1840.                    break;
  1841.                 default: error("Bad type argument to +. %d %d\n", 
  1842.                    (sp-1)->type, sp->type);
  1843.              }
  1844.              break;
  1845.           } 
  1846.           default: error("Bad type argument to +. %d %d\n", 
  1847.                    (sp-1)->type, sp->type);
  1848.        }
  1849.        pop_n_elems(2);
  1850.        push_svalue(&ret);
  1851.        free_svalue(&ret, "F_ADD");
  1852.        break;
  1853.     }      
  1854.     CASE(F_SUBTRACT);
  1855.     {
  1856.        struct svalue ret;
  1857.        ret.type = (sp-1)->type;
  1858.        switch((sp-1)->type)
  1859.        {
  1860.           case T_NUMBER:
  1861.           {
  1862.              switch(sp->type)
  1863.              {
  1864.                 case T_NUMBER:    
  1865.                    ret.u.number = (sp-1)->u.number - sp->u.number;
  1866.                    break;
  1867.                 default:
  1868.                    bad_arg(2, F_SUBTRACT);
  1869.                    break;
  1870.              }
  1871.              break;
  1872.           }
  1873.           case T_POINTER:
  1874. #ifdef COMPAT_MODE
  1875.                 ret.u.vec = subtract_array((sp-1)->u.vec, sp);
  1876. #else
  1877.              {
  1878.         if (sp->type == T_POINTER) {
  1879.             extern struct vector *subtract_array
  1880.               PROT((struct vector *,struct vector*));
  1881.             struct vector *v;
  1882.     
  1883.             v = sp->u.vec;
  1884.             if (v->ref > 1) {
  1885.             v = slice_array(v, 0, v->size-1 );
  1886.             v->ref--;
  1887.                 }
  1888.             sp--;
  1889.             v = subtract_array(sp->u.vec, v);
  1890.             free_vector(sp->u.vec);
  1891.             sp->u.vec = v;
  1892.         }
  1893.                 else bad_arg(2, F_SUBTRACT);
  1894.              }
  1895. #endif
  1896.              break;
  1897.           default: 
  1898.              bad_arg(1, F_SUBTRACT);
  1899.        }
  1900.        pop_n_elems(2);
  1901.        push_svalue(&ret);
  1902.        free_svalue(&ret, "F_SUBTRACT");
  1903.        break; 
  1904.     }
  1905.     CASE(F_AND);
  1906.     if (sp->type == T_POINTER && (sp-1)->type == T_POINTER) {
  1907.         extern struct vector *intersect_array
  1908.           PROT((struct vector *, struct vector *));
  1909.         (sp-1)->u.vec = intersect_array(sp->u.vec, (sp-1)->u.vec);
  1910.         sp--;
  1911.         break;
  1912.     }
  1913.     if ((sp-1)->type != T_NUMBER)
  1914.         bad_arg(1, F_AND);
  1915.     if (sp->type != T_NUMBER)
  1916.         bad_arg(2, F_AND);
  1917.     i = (sp-1)->u.number & sp->u.number;
  1918.     sp--;
  1919.     sp->u.number = i;
  1920.     break;
  1921.     CASE(F_OR);
  1922.     if ((sp-1)->type != T_NUMBER)
  1923.         bad_arg(1, F_OR);
  1924.     if (sp->type != T_NUMBER)
  1925.         bad_arg(2, F_OR);
  1926.     i = (sp-1)->u.number | sp->u.number;
  1927.     sp--;
  1928.     sp->u.number = i;
  1929.     break;
  1930.     CASE(F_XOR);
  1931.     if ((sp-1)->type != T_NUMBER)
  1932.         bad_arg(1, instruction);
  1933.     if (sp->type != T_NUMBER)
  1934.         bad_arg(2, instruction);
  1935.     i = (sp-1)->u.number ^ sp->u.number;
  1936.     sp--;
  1937.     sp->u.number = i;
  1938.     break;
  1939.     CASE(F_LSH);
  1940.     if ((sp-1)->type != T_NUMBER)
  1941.         bad_arg(1, instruction);
  1942.     if (sp->type != T_NUMBER)
  1943.         bad_arg(2, instruction);
  1944.     i = (sp-1)->u.number << sp->u.number;
  1945.     sp--;
  1946.     sp->u.number = i;
  1947.     break;
  1948.     CASE(F_RSH);
  1949.     if ((sp-1)->type != T_NUMBER)
  1950.         bad_arg(1, instruction);
  1951.     if (sp->type != T_NUMBER)
  1952.         bad_arg(2, instruction);
  1953.     i = (sp-1)->u.number >> sp->u.number;
  1954.     sp--;
  1955.     sp->u.number = i;
  1956.     break;
  1957.     CASE(F_MULTIPLY);
  1958.     if ((sp-1)->type != T_NUMBER)
  1959.         bad_arg(1, instruction);
  1960.     if (sp->type != T_NUMBER)
  1961.         bad_arg(2, instruction);
  1962.     i = (sp-1)->u.number * sp->u.number;
  1963.     sp--;
  1964.     sp->u.number = i;
  1965.     break;
  1966.     CASE(F_DIVIDE);
  1967.     if ((sp-1)->type != T_NUMBER)
  1968.         bad_arg(1, instruction);
  1969.     if (sp->type != T_NUMBER)
  1970.         bad_arg(2, instruction);
  1971.     if (sp->u.number == 0)
  1972.         error("Division by zero\n");
  1973.     i = (sp-1)->u.number / sp->u.number;
  1974.     sp--;
  1975.     sp->u.number = i;
  1976.     break;
  1977.     CASE(F_MOD);
  1978.     if ((sp-1)->type != T_NUMBER)
  1979.         bad_arg(1, instruction);
  1980.     if (sp->type != T_NUMBER)
  1981.         bad_arg(2, instruction);
  1982.     if (sp->u.number == 0)
  1983.         error("Modulus by zero.\n");
  1984.     i = (sp-1)->u.number % sp->u.number;
  1985.     sp--;
  1986.     sp->u.number = i;
  1987.     break;
  1988.     CASE(F_GT);
  1989.     if ((sp-1)->type == T_STRING && sp->type == T_STRING) {
  1990.         i = strcmp((sp-1)->u.string, sp->u.string) > 0;
  1991.         pop_n_elems(2);
  1992.         push_number(i);
  1993.         break;
  1994.     }
  1995.     if ((sp-1)->type != T_NUMBER)
  1996.         bad_arg(1, instruction);
  1997.     if (sp->type != T_NUMBER)
  1998.         bad_arg(2, instruction);
  1999.     i = (sp-1)->u.number > sp->u.number;
  2000.     sp--;
  2001.     sp->u.number = i;
  2002.     break;
  2003.     CASE(F_GE);
  2004.     if ((sp-1)->type == T_STRING && sp->type == T_STRING) {
  2005.         i = strcmp((sp-1)->u.string, sp->u.string) >= 0;
  2006.         pop_n_elems(2);
  2007.         push_number(i);
  2008.         break;
  2009.     }
  2010.     if ((sp-1)->type != T_NUMBER)
  2011.         bad_arg(1, instruction);
  2012.     if (sp->type != T_NUMBER)
  2013.         bad_arg(2, instruction);
  2014.     i = (sp-1)->u.number >= sp->u.number;
  2015.     sp--;
  2016.     sp->u.number = i;
  2017.     break;
  2018.     CASE(F_LT);
  2019.     if ((sp-1)->type == T_STRING && sp->type == T_STRING) {
  2020.         i = strcmp((sp-1)->u.string, sp->u.string) < 0;
  2021.         pop_n_elems(2);
  2022.         push_number(i);
  2023.         break;
  2024.     }
  2025.     if ((sp-1)->type != T_NUMBER)
  2026.         bad_arg(1, instruction);
  2027.     if (sp->type != T_NUMBER)
  2028.         bad_arg(2, instruction);
  2029.     i = (sp-1)->u.number < sp->u.number;
  2030.     sp--;
  2031.     sp->u.number = i;
  2032.     break;
  2033.     CASE(F_LE);
  2034.     if ((sp-1)->type == T_STRING && sp->type == T_STRING) {
  2035.         i = strcmp((sp-1)->u.string, sp->u.string) <= 0;
  2036.         pop_n_elems(2);
  2037.         push_number(i);
  2038.         break;
  2039.     }
  2040.     if ((sp-1)->type != T_NUMBER)
  2041.         bad_arg(1, instruction);
  2042.     if (sp->type != T_NUMBER)
  2043.         bad_arg(2, instruction);
  2044.     i = (sp-1)->u.number <= sp->u.number;
  2045.     sp--;
  2046.     sp->u.number = i;
  2047.     break;
  2048.     CASE(F_EQ);
  2049.     if ((sp-1)->type != sp->type) {
  2050.         pop_stack();
  2051.         assign_svalue(sp, &const0);
  2052.         break;
  2053.     }
  2054.     switch(sp->type) {
  2055.     case T_NUMBER:
  2056.         i = (sp-1)->u.number == sp->u.number;
  2057.         break;
  2058.     case T_POINTER:
  2059.         i = (sp-1)->u.vec == sp->u.vec;
  2060.         break;
  2061.     case T_STRING:
  2062.         i = strcmp((sp-1)->u.string, sp->u.string) == 0;
  2063.         break;
  2064.     case T_OBJECT:
  2065.         i = (sp-1)->u.ob == sp->u.ob;
  2066.         break;
  2067.     default:
  2068.         i = 0;
  2069.         break;
  2070.     }
  2071.     pop_n_elems(2);
  2072.     push_number(i);
  2073.     break;
  2074.     CASE(F_NE);
  2075.     if ((sp-1)->type != sp->type) {
  2076.         pop_stack();
  2077.         assign_svalue(sp, &const1);
  2078.         break;
  2079.     }
  2080.     switch(sp->type) {
  2081.     case T_NUMBER:
  2082.         i = (sp-1)->u.number != sp->u.number;
  2083.         break;
  2084.     case T_STRING:
  2085.         i = strcmp((sp-1)->u.string, sp->u.string);
  2086.         break;
  2087.     case T_POINTER:
  2088.         i = (sp-1)->u.vec != sp->u.vec;
  2089.         break;
  2090.     case T_OBJECT:
  2091.         i = (sp-1)->u.ob != sp->u.ob;
  2092.         break;
  2093.     default:
  2094.         fatal("Illegal type to !=\n");
  2095.     }
  2096.     pop_n_elems(2);
  2097.     push_number(i);
  2098.     break;
  2099.     CASE(F_LOG_FILE);
  2100.     log_file((sp-1)->u.string, sp->u.string);
  2101.     pop_stack();
  2102.     break;    /* Return first argument */
  2103.     CASE(F_NOT);
  2104.     if (sp->type == T_NUMBER && sp->u.number == 0)
  2105.         sp->u.number = 1;
  2106.     else
  2107.         assign_svalue(sp, &const0);
  2108.     break;
  2109.     CASE(F_COMPL);
  2110.     if (sp->type != T_NUMBER)
  2111.         error("Bad argument to ~\n");
  2112.     sp->u.number = ~ sp->u.number;
  2113.     break;
  2114.     CASE(F_NEGATE);
  2115.     if (sp->type != T_NUMBER)
  2116.         error("Bad argument to unary minus\n");
  2117.     sp->u.number = - sp->u.number;
  2118.     break;
  2119.     CASE(F_INC);
  2120.     if (sp->type != T_LVALUE)
  2121.         error("Bad argument to ++\n");
  2122.     if (sp->u.lvalue->type != T_NUMBER)
  2123.         error("++ of non-numeric argument\n");
  2124.     sp->u.lvalue->u.number++;
  2125.     assign_svalue(sp, sp->u.lvalue);
  2126.     break;
  2127.     CASE(F_DEC);
  2128.     if (sp->type != T_LVALUE)
  2129.         error("Bad argument to --\n");
  2130.     if (sp->u.lvalue->type != T_NUMBER)
  2131.         error("-- of non-numeric argument\n");
  2132.     sp->u.lvalue->u.number--;
  2133.     assign_svalue(sp, sp->u.lvalue);
  2134.     break;
  2135.     CASE(F_POST_INC);
  2136.     if (sp->type != T_LVALUE)
  2137.         error("Bad argument to ++\n");
  2138.     if (sp->u.lvalue->type != T_NUMBER)
  2139.         error("++ of non-numeric argument\n");
  2140.     sp->u.lvalue->u.number++;
  2141.     assign_svalue(sp, sp->u.lvalue);
  2142.     sp->u.number--;
  2143.     break;
  2144.     CASE(F_POST_DEC);
  2145.     if (sp->type != T_LVALUE)
  2146.         error("Bad argument to --\n");
  2147.     if (sp->u.lvalue->type != T_NUMBER)
  2148.         error("-- of non-numeric argument\n");
  2149.     sp->u.lvalue->u.number--;
  2150.     assign_svalue(sp, sp->u.lvalue);
  2151.     sp->u.number++;
  2152.     break;
  2153.     CASE(F_CALL_OTHER);
  2154.     {
  2155.     struct svalue *arg, tmp;
  2156.     
  2157.     arg = sp - num_arg + 1;
  2158.     if (arg[0].type == T_OBJECT)
  2159.         ob = arg[0].u.ob;
  2160.     else {
  2161.         ob = find_object(arg[0].u.string);
  2162.         if (ob == 0)
  2163.                 error("Could not find object %s\n", arg[0].u.string);
  2164.        /* Raistlin -- Was this 
  2165.         fatal("find_object() returned 0\n");  */
  2166.     }
  2167.  
  2168.     if ((current_object->flags & O_DESTRUCTED) ||
  2169.       (ob->flags & O_DESTRUCTED)) {
  2170.         /*
  2171.          * No external calls may be done when this object is
  2172.          * destructed.
  2173.          */
  2174.         pop_n_elems(num_arg);
  2175.         push_number(0);
  2176.         break;
  2177.     }
  2178.     if (arg[1].u.string[0] == ':')
  2179.         error("Illegal function name in call_other: %s\n",
  2180.           arg[1].u.string);
  2181.     /*
  2182.      * Send the remaining arguments to the function.
  2183.      */
  2184.     if (TRACEP(TRACE_CALL_OTHER)) {
  2185.         do_trace("Call other ", arg[1].u.string, "\n");
  2186.     }
  2187.     if (apply_low(arg[1].u.string, ob, num_arg-2) == 0) {
  2188.         /* Function not found */
  2189.         pop_n_elems(2);
  2190.         push_number(0);
  2191.         break;
  2192.     }
  2193.     /*
  2194.      * The result of the function call is on the stack. But, so
  2195.      * is the function name and object that was called.
  2196.      * These have to be removed.
  2197.      */
  2198.     tmp = *sp--;    /* Copy the function call result */
  2199.     pop_n_elems(2);    /* Remove old arguments to call_other */
  2200.     *++sp = tmp;    /* Re-insert function result */
  2201.     break;
  2202.     }
  2203.     CASE(F_INTP);
  2204.     if (sp->type == T_NUMBER)
  2205.         assign_svalue(sp, &const1);
  2206.     else
  2207.         assign_svalue(sp, &const0);
  2208.     break;
  2209.     CASE(F_STRINGP);
  2210.     if (sp->type == T_STRING)
  2211.         assign_svalue(sp, &const1);
  2212.     else
  2213.         assign_svalue(sp, &const0);
  2214.     break;
  2215.     CASE(F_OBJECTP);
  2216.     if (sp->type == T_OBJECT)
  2217.         assign_svalue(sp, &const1);
  2218.     else
  2219.         assign_svalue(sp, &const0);
  2220.     break;
  2221.     CASE(F_POINTERP);
  2222.     if (sp->type == T_POINTER)
  2223.         assign_svalue(sp, &const1);
  2224.     else
  2225.         assign_svalue(sp, &const0);
  2226.     break;
  2227.     CASE(F_EXTRACT);
  2228.     {
  2229.     int len, from, to;
  2230.     struct svalue *arg;
  2231.     char *res;
  2232.  
  2233.     arg = sp - num_arg + 1;
  2234.     if (num_arg == 1)
  2235.         break;        /* Simply return argument */
  2236.         if (arg[0].type == T_POINTER)
  2237.         {
  2238.            struct vector *r;
  2239.            int from, to, i; 
  2240.            
  2241.            from = arg[1].u.number;
  2242.            if (num_arg == 3) to = arg[2].u.number;
  2243.            else to = arg[0].u.vec->size-1;
  2244.  
  2245.            if (from > arg[0].u.vec->size-1 || to < from) {
  2246.               pop_n_elems(num_arg);
  2247.               push_number(0);
  2248.               break;
  2249.            }  
  2250.            if (to > arg[0].u.vec->size-1)
  2251.               to = arg[0].u.vec->size-1;
  2252.            r = allocate_array(to - from + 1);
  2253.            for (i = from; i <= to; ++i)
  2254.               assign_svalue(&r->item[i-from], &arg[0].u.vec->item[i]);
  2255.            pop_n_elems(num_arg);
  2256.            push_vector(r);
  2257.            r->ref--;
  2258.            break;
  2259.         } 
  2260.     len = strlen(arg[0].u.string);
  2261.     from = arg[1].u.number;
  2262.     if (from < 0)
  2263.         from = len + from;
  2264.     if (from >= len) {
  2265.         pop_n_elems(num_arg);
  2266.         push_string("", STRING_CONSTANT);
  2267.         break;
  2268.     }
  2269.     if (num_arg == 2) {
  2270.         res = make_shared_string(arg->u.string + from);
  2271.         pop_n_elems(2);
  2272.         push_shared_string(res); /**MALLOC**/
  2273.         break;
  2274.     }
  2275.     if (arg[2].type != T_NUMBER)
  2276.         error("Bad third argument to extract()\n");
  2277.     to = arg[2].u.number;
  2278.     if (to < 0)
  2279.         to = len + to;
  2280.     if (to < from) {
  2281.         pop_n_elems(3);
  2282.         push_string("", STRING_CONSTANT);
  2283.         break;
  2284.     }
  2285.     if (to >= len)
  2286.         to = len-1;
  2287.     if (to == len-1) {
  2288.         res = make_shared_string(arg->u.string + from);
  2289.         pop_n_elems(3);
  2290.         push_shared_string(res); /**MALLOC**/
  2291.         break;
  2292.     }
  2293.     res = xalloc(to - from + 2);
  2294.     strncpy(res, arg[0].u.string + from, to - from + 1);
  2295.     res[to - from + 1] = '\0';
  2296.     pop_n_elems(3);
  2297.     push_shared_string(make_shared_string(res)); /*MALLOC*/
  2298.         free(res);
  2299.     break;
  2300.     }
  2301.     CASE(F_ATOI);
  2302.     {
  2303.        int i = atoi(sp->u.string);
  2304.        pop_stack();
  2305.        push_number(i);
  2306.        break;
  2307.     }
  2308.     CASE(F_RANGE);
  2309.     {
  2310.     if (sp[-1].type != T_NUMBER)
  2311.         error("Bad type of start interval to [ .. ] range.\n");
  2312.     if (sp[0].type != T_NUMBER)
  2313.         error("Bad type of end interval to [ .. ] range.\n");
  2314.     if (sp[-2].type == T_POINTER) {
  2315.         struct vector *v;
  2316.  
  2317.         v = slice_array(sp[-2].u.vec, sp[-1].u.number, sp[0].u.number);
  2318.         pop_n_elems(3);
  2319.         if (v) {
  2320.         push_vector(v);
  2321.         v->ref--;    /* Will make ref count == 1 */
  2322.         } else {
  2323.         push_number(0);
  2324.         }
  2325.     } else if (sp[-2].type == T_STRING) {
  2326.         int len, from, to;
  2327.         char *res;
  2328.         
  2329.         len = strlen(sp[-2].u.string);
  2330.         from = sp[-1].u.number;
  2331.         if (from < 0)
  2332.         from = len + from;
  2333.         if (from >= len) {
  2334.         pop_n_elems(3);
  2335.         push_string("", STRING_CONSTANT);
  2336.         break;
  2337.         }
  2338.         to = sp[0].u.number;
  2339.         if (to < 0)
  2340.         to = len + to;
  2341.         if (to < from) {
  2342.         pop_n_elems(3);
  2343.         push_string("", STRING_CONSTANT);
  2344.         break;
  2345.         }
  2346.         if (to >= len)
  2347.         to = len-1;
  2348.         if (to == len-1) {
  2349.         res = string_copy(sp[-2].u.string + from);
  2350.         pop_n_elems(3);
  2351.         push_malloced_string(res);
  2352.         break;
  2353.         }
  2354.         res = xalloc(to - from + 2);
  2355.         strncpy(res, sp[-2].u.string + from, to - from + 1);
  2356.         res[to - from + 1] = '\0';
  2357.         pop_n_elems(3);
  2358.         push_malloced_string(res);
  2359.     } else {
  2360.         error("Bad argument to [ .. ] range operand.\n");
  2361.     }
  2362.     break;
  2363.     }
  2364.     CASE(F_QUERY_ARG);
  2365.     case F_THIS_ARG:
  2366.     if (last_arg == 0) {
  2367.         push_number(0);
  2368.         break;
  2369.     }
  2370.     push_string(last_arg, STRING_CONSTANT);
  2371.     break;
  2372.     CASE(F_QUERY_VERB);
  2373.     case F_THIS_VERB:
  2374.     if (last_verb == 0) {
  2375.         push_number(0);
  2376.         break;
  2377.     }
  2378.     push_string(last_verb, STRING_CONSTANT);
  2379.     break;
  2380.     CASE(F_EXEC);
  2381.     i =replace_interactive((sp-1)->u.ob, sp->u.ob, current_prog->name);
  2382.     pop_n_elems(2);
  2383.     push_number(i);
  2384.     break;
  2385.  
  2386.     CASE(F_FILE_NAME);
  2387.     {
  2388.     char *name,*res;
  2389.  
  2390.     name = sp->u.ob->name;
  2391. #ifdef COMPAT_MODE
  2392.         res = string_copy(name); 
  2393. #else
  2394.         res = add_slash(name);
  2395. #endif
  2396.     pop_stack();
  2397.     push_shared_string(make_shared_string(res)); /*MALLOC*/
  2398.         free(res);
  2399.     break;
  2400.     }
  2401.     CASE(F_USERS);
  2402.     push_vector(users());    /* users() has already set ref count to 1 */
  2403.     sp->u.vec->ref--;
  2404.     break;
  2405.     CASE(F_CALL_OUT);
  2406.     {
  2407.         struct svalue *arg = sp - num_arg + 1;
  2408.  
  2409.         if (!(current_object->flags & O_DESTRUCTED))
  2410.         new_call_out(current_object, arg[0].u.string, arg[1].u.number,
  2411.                  num_arg == 3 ? sp : 0);
  2412.         pop_n_elems(num_arg);
  2413.         push_number(0);
  2414.     }
  2415.     break;
  2416.     CASE(F_CALL_OUT_INFO);
  2417.     push_vector(get_all_call_outs());
  2418.     sp->u.vec->ref--;    /* Was set to 1 at allocation */
  2419.     break;
  2420.     CASE(F_REMOVE_CALL_OUT);
  2421.     i = remove_call_out(current_object, sp->u.string);
  2422.     pop_stack();
  2423.     push_number(i);
  2424.     break;
  2425.     CASE(F_WRITE);
  2426.     do_write(sp);
  2427.     break;
  2428.     CASE(F_MOVE_OBJECT);
  2429.     {
  2430.     struct object *o1, *o2;
  2431.  
  2432.     if ((sp-1)->type == T_OBJECT)
  2433.         o1 = (sp-1)->u.ob;
  2434.     else {
  2435.         o1 = find_object((sp-1)->u.string);
  2436.         if (o1 == 0)
  2437.         error("move_object failed\n");
  2438.     }
  2439.     if (sp->type == T_OBJECT)
  2440.         o2 = sp->u.ob;
  2441.     else {
  2442.         o2 = find_object(sp->u.string);
  2443.         if (o2 == 0)
  2444.         error("move_object failed\n");
  2445.     }
  2446.     move_object(o1, o2);
  2447.     pop_stack();
  2448.     break;
  2449.     }
  2450.     CASE(F_FUNCTION_EXISTS);
  2451.     {
  2452.     char *str, *res;
  2453.  
  2454.     str = function_exists((sp-1)->u.string, sp->u.ob);
  2455.     pop_n_elems(2);
  2456.     if (str) {
  2457.         extern char *strrchr();
  2458.  
  2459. /* Raistlin -- made it use shared strings */
  2460.             res = str;
  2461.         /* marion - strip trailing .c */
  2462.         if (str = strrchr (res, (int)'.')) *str = 0;
  2463. #ifdef COMPAT_MODE
  2464.                push_shared_string(make_shared_string(res));
  2465. #else
  2466.             {
  2467.            res = add_slash(res);
  2468.                push_shared_string(make_shared_string(res));
  2469.                free(res);
  2470.              /**MALLOC**/
  2471.             } 
  2472. #endif
  2473.     } else {
  2474.         push_number(0);
  2475.     }
  2476.     break;
  2477.     }
  2478.     CASE(F_SNOOP);
  2479.     {
  2480.     /* This one takes a variable number of arguments. It returns
  2481.      * 0 or an object.
  2482.      */
  2483. #ifdef COMPAT_MODE
  2484.         struct svalue *a;
  2485.     if (!command_giver || num_arg == 2) 
  2486.         {
  2487.         pop_n_elems (num_arg);
  2488.         push_number (0);
  2489.         }
  2490.         a = apply("query_level", command_giver, 0);
  2491.         if (!a || a->type != T_NUMBER || a->u.number < SNOOP_LEVEL) 
  2492.         {
  2493.            pop_n_elems(num_arg);
  2494.            push_number(0);
  2495.         }
  2496.         else if (num_arg == 0) 
  2497.         {
  2498.             set_snoop(command_giver, (struct object *)0);
  2499.             push_number(0);
  2500.         } 
  2501.         else
  2502.        set_snoop(command_giver, sp->u.ob);
  2503. #else
  2504.     if (!command_giver) {
  2505.         pop_n_elems(num_arg);
  2506.             push_number(0);
  2507.     } else {
  2508.         ob = 0; /* Do not remove this, it is not 0 by default */
  2509.             switch (num_arg) {
  2510.         case 1:
  2511.             if (new_set_snoop(sp->u.ob, 0))
  2512.                 ob = sp->u.ob;
  2513.         break;
  2514.         case 2:
  2515.         if (new_set_snoop((sp-1)->u.ob, sp->u.ob))
  2516.             ob = sp->u.ob;
  2517.         break;
  2518.             default:
  2519.             ob = 0;
  2520.             break;
  2521.         }
  2522.             pop_n_elems(num_arg);
  2523.         if (ob)
  2524.             push_object(ob, "F_SNOOP");
  2525.         else
  2526.         push_number(0);
  2527.     }
  2528. #endif
  2529.     break;
  2530.     }
  2531.     CASE(F_ADD_ACTION);
  2532.     {
  2533.     struct svalue *arg = sp - num_arg + 1;
  2534.     if (num_arg == 3) {
  2535.         if (arg[2].type != T_NUMBER)
  2536.         bad_arg(3, instruction);
  2537.     }
  2538.     add_action(arg[0].u.string,
  2539.            num_arg > 1 ? arg[1].u.string : 0,
  2540.            num_arg > 2 ? arg[2].u.number : 0);
  2541.     pop_n_elems(num_arg-1);
  2542.     break;
  2543.     }
  2544.     CASE(F_ADD_VERB);
  2545.     add_verb(sp->u.string, 0);
  2546.     break;
  2547.     CASE(F_ADD_XVERB);
  2548.     add_verb(sp->u.string, 1);
  2549.     break;
  2550.     CASE(F_ALLOCATE);
  2551.     {
  2552.     struct vector *v;
  2553.  
  2554.     v = allocate_array(sp->u.number);    /* Will have ref count == 1 */
  2555.     pop_stack();
  2556.     push_vector(v);
  2557.     v->ref--;
  2558.     break;
  2559.     }
  2560.     CASE(F_ED);
  2561.     if (num_arg == 0) {
  2562.         struct svalue *arg;
  2563.         char *err_file;
  2564.  
  2565.         if (command_giver == 0 || command_giver->interactive == 0) {
  2566.         push_number(0);
  2567.         break;
  2568.         }
  2569.         arg = sapply("query_real_name", command_giver, 0);
  2570.         if (arg == 0 || arg->type != T_STRING) {
  2571.         push_number(0);
  2572.         break;
  2573.         }
  2574.         err_file = get_error_file(arg->u.string);
  2575.         if (err_file == 0) {
  2576.         push_number(0);
  2577.         break;
  2578.         }
  2579.         ed_start(err_file, 0, 0);
  2580.         push_number(1);
  2581.         break;
  2582.     } else if (num_arg == 1) {
  2583.         ed_start(sp->u.string, 0, 0);
  2584.     } else {
  2585.         if (sp->type == T_STRING)
  2586.             ed_start((sp-1)->u.string, sp->u.string, current_object);
  2587.         else
  2588.         ed_start((sp-1)->u.string, 0 , 0);
  2589.         pop_stack();
  2590.     }
  2591.     break;
  2592.     CASE(F_CRYPT);
  2593.     {
  2594.     char salt[2];
  2595.     char *res;
  2596.     char *choise =
  2597.         "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789./";
  2598.  
  2599.     if (sp->type == T_STRING && strlen(sp->u.string) >= 2) {
  2600.         salt[0] = sp->u.string[0];
  2601.         salt[1] = sp->u.string[1];
  2602.     } else {
  2603.         salt[0] = choise[random_number(strlen(choise))];
  2604.         salt[1] = choise[random_number(strlen(choise))];
  2605.     }
  2606. #ifdef sun
  2607.     res = make_shared_string(_crypt((sp-1)->u.string, salt)); /**MALLOC**/
  2608. #else
  2609.     res = make_shared_string(crypt((sp-1)->u.string, salt)); /**MALLOC**/
  2610. #endif
  2611.     pop_n_elems(2);
  2612.     push_shared_string(res);
  2613.     break;
  2614.     }
  2615. #ifdef F_CREATE_WIZARD
  2616.     CASE(F_CREATE_WIZARD);
  2617.     {
  2618.     char *str;
  2619.     struct svalue *arg = sp - num_arg + 1;
  2620.     str = create_wizard(arg[0].u.string,
  2621.                 num_arg == 2 ? arg[1].u.string : 0);
  2622.     pop_n_elems(num_arg);
  2623.     if (str)
  2624.         push_string(str, STRING_CONSTANT);
  2625.     else
  2626.         push_number(0);
  2627.     break;
  2628.     }
  2629. #endif
  2630.     CASE(F_DESTRUCT);
  2631.     {
  2632.         int really;
  2633.  
  2634.         if (num_arg == 2)
  2635.         {
  2636.            really = sp->u.number;
  2637.            pop_stack();
  2638.         }
  2639.         else really = 0;
  2640.     destruct_object(sp, really);
  2641.     break;
  2642.     }
  2643.     CASE(F_RANDOM);
  2644.     if (sp->u.number <= 0) {
  2645.         sp->u.number = 0;
  2646.         break;
  2647.     }
  2648.     sp->u.number = random_number(sp->u.number);
  2649.     break;
  2650.     CASE(F_SAY);
  2651. #if 0
  2652.     if (num_arg == 1)
  2653.         say(sp, 0);
  2654.     else {
  2655.         say(sp-1, sp->u.ob);
  2656.         pop_stack();
  2657.     }
  2658. #else
  2659.         {
  2660.         static struct {
  2661.         struct vector v;
  2662.         struct svalue second_item[1];
  2663.         } vtmp = { { 2, 1,
  2664. #ifdef DEBUG
  2665.         1,
  2666. #endif
  2667.         (struct wiz_list *)NULL,
  2668.         { { T_NUMBER } } }, { { T_OBJECT } }
  2669.         };
  2670.  
  2671.     if (num_arg == 1) {
  2672.         vtmp.v.item[0].type = T_NUMBER; /* this marks the place for the
  2673.                         command_giver
  2674.                           */
  2675.         vtmp.v.item[1].type = T_NUMBER; /* will not match any object... */
  2676.         say(sp, &vtmp.v);
  2677.     } else {
  2678.         if ( sp->type == T_POINTER ) {
  2679.         if (sp->u.vec->ref > 1) {
  2680.             struct vector *vtmpp =
  2681.               slice_array(sp->u.vec, 0, sp->u.vec->size-1);
  2682.             say(sp-1, vtmpp);
  2683.             free_vector(vtmpp);
  2684.         } else
  2685.                 say(sp-1, sp->u.vec);
  2686.         } else {
  2687.             vtmp.v.item[0].type = T_NUMBER;
  2688.         vtmp.v.item[1].type = T_OBJECT;
  2689.             vtmp.v.item[1].u.ob = sp->u.ob;
  2690.                 add_ref(sp->u.ob, "F_SAY");
  2691.             say(sp-1, &vtmp.v);
  2692.         }
  2693.         pop_stack();
  2694.     }
  2695.     break;
  2696.     }
  2697. #endif
  2698.     break;
  2699.     CASE(F_TELL_ROOM);
  2700.     {
  2701.     extern struct vector null_vector;
  2702.     struct svalue *arg = sp- num_arg + 1;
  2703.     struct vector *avoid;
  2704.  
  2705.     if (arg[0].type == T_OBJECT)
  2706.         ob = arg[0].u.ob;
  2707.     else {
  2708.         ob = find_object(arg[0].u.string);
  2709.         if (ob == 0)
  2710.         error("Object not found.\n");
  2711.     }
  2712.     if (num_arg == 2) {
  2713.         avoid = &null_vector;
  2714.         avoid->ref++;
  2715.     } else {
  2716.         extern struct vector *order_alist PROT((struct vector *));
  2717.         struct vector *vtmpp;
  2718.         static struct vector vtmp = { 1, 1,
  2719. #ifdef DEBUG
  2720.         1,
  2721. #endif
  2722.         (struct wiz_list *)NULL,
  2723.         { { T_POINTER } }
  2724.         };
  2725.  
  2726.         if (arg[2].type != T_POINTER)
  2727.         bad_arg(3, instruction);
  2728.         vtmp.item[0].u.vec = arg[2].u.vec;
  2729.         if (vtmp.item[0].u.vec->ref > 1) {
  2730.         vtmp.item[0].u.vec->ref--;
  2731.         vtmp.item[0].u.vec = slice_array(
  2732.           vtmp.item[0].u.vec, 0, vtmp.item[0].u.vec->size-1);
  2733.         }
  2734.         sp--;
  2735.         vtmpp = order_alist(&vtmp);
  2736.         avoid = vtmpp->item[0].u.vec;
  2737.         vtmpp->item[0].u.vec = vtmp.item[0].u.vec;
  2738.         free_vector(vtmpp);
  2739.     }
  2740.     tell_room(ob, sp, avoid);
  2741.     free_vector(avoid);
  2742.     pop_stack();
  2743.     break;
  2744.     }
  2745.     CASE(F_SHOUT);
  2746.     shout_string(sp->u.string);
  2747.     break;
  2748.     CASE(F_WHILE);
  2749.     fatal("F_WHILE should not appear.\n");
  2750.     CASE(F_DO);
  2751.     fatal("F_DO should not appear.\n");
  2752.     CASE(F_FOR);
  2753.     fatal("F_FOR should not appear.\n");
  2754.     CASE(F_SWITCH);
  2755.     {
  2756.     extern char* findstring PROT((char*));
  2757.     unsigned short offset,break_adr;
  2758.     int d,s,r;
  2759.     char *l,*end_tab;
  2760.     static short off_tab[] = { 0*6,1*6,3*6,7*6,15*6,31*6,63*6,127*6,255*6,
  2761.                     511*6,1023*6,2047*6,4095*6,8191*6 };
  2762.  
  2763.     ((char *)&offset)[0] = pc[1];
  2764.     ((char *)&offset)[1] = pc[2];
  2765.     ((char *)&break_adr)[0] = pc[3];
  2766.     ((char *)&break_adr)[1] = pc[4];
  2767.     *--break_sp = break_adr;
  2768.     if ( ( i = EXTRACT_UCHAR(pc) >> 4 ) != 0xf ) {
  2769.         if ( sp->type == T_NUMBER && !sp->u.number ) {
  2770.         /* special case: uninitalized string */
  2771.         s = ZERO_AS_STR_CASE_LABEL;
  2772.         } else if ( sp->type == T_STRING ) {
  2773.             switch(sp->string_type) {
  2774.             case STRING_SHARED:
  2775.                 s = (int)sp->u.string;
  2776.                 break;
  2777.         default:
  2778.             s = (int)findstring(sp->u.string);
  2779.                 break;
  2780.             }
  2781.         } else {
  2782.         bad_arg(1, F_SWITCH);
  2783.         }
  2784.     } else {
  2785.         if (sp->type != T_NUMBER) bad_arg(1, F_SWITCH);
  2786.         s = sp->u.number;
  2787.         i = (int)pc[0] &0xf ;
  2788.     }
  2789.     pop_stack();
  2790.     end_tab = current_prog->program + break_adr;
  2791.     if ( i >= 14 )
  2792.         if ( i == 14 ) {
  2793.         /* fastest switch format : lookup table */
  2794.             l = current_prog->program + offset;
  2795.                 ((char *)&d)[0] = end_tab[-4];
  2796.                 ((char *)&d)[1] = end_tab[-3];
  2797.                 ((char *)&d)[2] = end_tab[-2];
  2798.                 ((char *)&d)[3] = end_tab[-1];
  2799.         if ( s >= d && l + (s=(s-d)*sizeof(short)) < end_tab - 4 ) {
  2800.             ((char *)&offset)[0] = l[s];
  2801.             ((char *)&offset)[1] = l[s+1];
  2802.             if (offset) {
  2803.             pc = current_prog->program + offset;
  2804.             break;
  2805.             }
  2806.         }
  2807.         /* default */
  2808.         ((char *)&offset)[0] = pc[5];
  2809.         ((char *)&offset)[1] = pc[6];
  2810.         pc = current_prog->program + offset;
  2811.         break;
  2812.         } else
  2813.         fatal("unsupported switch table format.\n");
  2814.     l = current_prog->program + offset + off_tab[i];
  2815.     d = (off_tab[i]+6) >> 1;
  2816.     if (d == 3) d=0;
  2817.     for(;;) {
  2818.         ((char *)&r)[0] = l[0];
  2819.         ((char *)&r)[1] = l[1];
  2820.         ((char *)&r)[2] = l[2];
  2821.         ((char *)&r)[3] = l[3];
  2822.         if (s < r)
  2823.                 if (d < 6) {
  2824.                     if (!d) { /* test for range */
  2825.             ((char *)&offset)[0] = l[-2];
  2826.             ((char *)&offset)[1] = l[-1];
  2827.  
  2828.             /* F_BREAK is required to be > 1 */
  2829.             if (offset <= 1) {
  2830.                     ((char *)&r)[0] = l[-6];
  2831.                     ((char *)&r)[1] = l[-5];
  2832.                     ((char *)&r)[2] = l[-4];
  2833.                     ((char *)&r)[3] = l[-3];
  2834.                 if (s >= r) {
  2835.                 /* s is in the range */
  2836.                 if (!offset) {
  2837.                     /* range with lookup table */
  2838.                                     ((char *)&offset)[0] = l[4];
  2839.                                     ((char *)&offset)[1] = l[5];
  2840.                     l = current_prog->program + offset +
  2841.                     (s-r) * sizeof(short);
  2842.                                     ((char *)&offset)[0] = l[0];
  2843.                                     ((char *)&offset)[1] = l[1];
  2844.                     break;
  2845.                 }
  2846.                 ((char *)&offset)[0] = l[4];
  2847.                 ((char *)&offset)[1] = l[5];
  2848.                 break;
  2849.                 }
  2850.             }
  2851.             /* use default address */
  2852.                         ((char *)&offset)[0] = pc[5];
  2853.                         ((char *)&offset)[1] = pc[6];
  2854.                         break;
  2855.                     } /* !d */
  2856.                     d = 0;
  2857.                 } else {
  2858.             /* d >= 6 */
  2859.                     l -= d;
  2860.                     d >>= 1;
  2861.         }
  2862.         else if (s > r) {
  2863.                 if (d < 6) {
  2864.                     if (!d) { /* test for range */
  2865.             ((char *)&offset)[0] = l[4];
  2866.             ((char *)&offset)[1] = l[5];
  2867.             if (offset <= 1) {
  2868.                     ((char *)&r)[0] = l[6];
  2869.                     ((char *)&r)[1] = l[7];
  2870.                     ((char *)&r)[2] = l[8];
  2871.                     ((char *)&r)[3] = l[9];
  2872.                 if (s <= r) {
  2873.                 /* s is in the range */
  2874.                 if (!offset) {
  2875.                     /* range with lookup table */
  2876.                                     ((char *)&offset)[0] = l[10];
  2877.                                     ((char *)&offset)[1] = l[11];
  2878.                     l = current_prog->program + offset +
  2879.                     (s-r) * sizeof(short);
  2880.                                     ((char *)&offset)[0] = l[0];
  2881.                                     ((char *)&offset)[1] = l[1];
  2882.                     break;
  2883.                 }
  2884.                 ((char *)&offset)[0] = l[10];
  2885.                 ((char *)&offset)[1] = l[11];
  2886.                 break;
  2887.                 }
  2888.             }
  2889.             /* use default address */
  2890.                         ((char *)&offset)[0] = pc[5];
  2891.                         ((char *)&offset)[1] = pc[6];
  2892.                         break;
  2893.                     } /* !d */
  2894.                     d = 0;
  2895.                 } else {
  2896.             /* d >= 6 */
  2897.                     l += d;
  2898.                     while (l >= end_tab) {
  2899.                         d >>= 1;
  2900.                         if (d <= 3) {
  2901.                             if (!d) break;
  2902.                             d = 0;
  2903.                         }
  2904.                         l -= d;
  2905.                     }
  2906.             d >>= 1;
  2907.         }
  2908.         } else {
  2909.         /* s == r */
  2910.         ((char *)&offset)[0] = l[4];
  2911.         ((char *)&offset)[1] = l[5];
  2912.         if ( !l[-2] && !l[-1] ) {
  2913.             /* end of range with lookup table */
  2914.             ((char *)&r)[0] = l[-6];
  2915.             ((char *)&r)[1] = l[-5];
  2916.             ((char *)&r)[2] = l[-4];
  2917.             ((char *)&r)[3] = l[-3];
  2918.             l = current_prog->program + offset + (s-r)*sizeof(short);
  2919.                     ((char *)&offset)[0] = l[0];
  2920.                     ((char *)&offset)[1] = l[1];
  2921.         }
  2922.         if (offset <= 1) {
  2923.             if (!offset) {
  2924.             /* start of range with lookup table */
  2925.                         ((char *)&offset)[0] = l[10];
  2926.                         ((char *)&offset)[1] = l[11];
  2927.             l = current_prog->program + offset;
  2928.                         ((char *)&offset)[0] = l[0];
  2929.                         ((char *)&offset)[1] = l[1];
  2930.             } else {
  2931.                         ((char *)&offset)[0] = l[10];
  2932.                         ((char *)&offset)[1] = l[11];
  2933.             }
  2934.         }
  2935.         break;
  2936.         }
  2937.     }
  2938.     pc = current_prog->program + offset;
  2939.     break;
  2940.     }
  2941.     CASE(F_BREAK);
  2942.     {
  2943.     pc = current_prog->program + *break_sp++;
  2944.     break;
  2945.     }
  2946.     CASE(F_SUBSCRIPT);
  2947.     fatal("F_SUBSCRIPT should not appear.\n");
  2948.     CASE(F_STRLEN);
  2949.     i = strlen(sp->u.string);
  2950.     pop_stack();
  2951.     push_number(i);
  2952.     break;
  2953.     CASE(F_SIZEOF);
  2954.         if (sp->type == T_NUMBER)
  2955.            i = 0;
  2956.         else
  2957.        i = sp->u.vec->size;
  2958.     pop_stack();
  2959.     push_number(i);
  2960.     break;
  2961.     CASE(F_LOWER_CASE);
  2962.     {
  2963.     char *str = string_copy(sp->u.string);
  2964.     for (i = strlen(str)-1; i>=0; i--)
  2965.         if (isalpha(str[i]))
  2966.         str[i] |= 'a' - 'A';
  2967.     pop_stack();
  2968.     push_shared_string(make_shared_string(str)); /*MALLOC*/
  2969.         free(str);
  2970.     break;
  2971.     }
  2972.     CASE(F_SET_HEART_BEAT);
  2973.     i = set_heart_beat(current_object, sp->u.number);
  2974.     sp->u.number = i;
  2975.     break;
  2976.     CASE(F_CAPITALIZE);
  2977.     if (islower(sp->u.string[0])) {
  2978.         char *str;
  2979.  
  2980.         str = string_copy(sp->u.string);
  2981.         str[0] += 'A' - 'a';
  2982.         pop_stack();
  2983.         push_shared_string(make_shared_string(str));
  2984.             free(str);/*MALLOC*/
  2985.     }
  2986.     break;
  2987.     CASE(F_PROCESS_STRING);
  2988.     {
  2989.         extern char *process_string PROT((char *));
  2990.    
  2991.         char *str;
  2992.    
  2993.         str = process_string(sp->u.string);
  2994.         if (str != sp->u.string) {
  2995.             pop_stack();
  2996.             push_shared_string(make_shared_string(str));
  2997.         }
  2998.         break;
  2999.     }
  3000.     CASE(F_COMMAND);
  3001.     {
  3002.     struct svalue *arg = sp - num_arg + 1;
  3003.  
  3004.     if (num_arg == 1)
  3005.         i = command_for_object(arg[0].u.string, 0);
  3006.     else
  3007. #ifdef COMPAT_MODE
  3008.         i = command_for_object(arg[0].u.string, arg[1].u.ob);
  3009. #else
  3010.         error("Too many arguments to command().\n");
  3011. #endif
  3012.     pop_n_elems(num_arg);
  3013.     push_number(i);
  3014.     break;
  3015.     }
  3016.     CASE(F_GET_DIR);
  3017.     {
  3018.     struct vector *v = get_dir(sp->u.string);
  3019.     pop_stack();
  3020.     if (v) {
  3021.         push_vector(v);
  3022.         v->ref--;    /* Will now be 1. */
  3023.     } else
  3024.         push_number(0);
  3025.     break;
  3026.     }
  3027.     CASE(F_LS);
  3028.         if (sp->type == T_NUMBER)
  3029.            list_files(NULL);
  3030.         else
  3031.        list_files(sp->u.string);
  3032.     break;
  3033.     CASE(F_RM);
  3034.     i = remove_file(sp->u.string);
  3035.     pop_stack();
  3036.     push_number(i);
  3037.     break;
  3038.     CASE(F_CAT);
  3039.     {
  3040.     struct svalue *arg = sp- num_arg + 1;
  3041.     int start = 0, len = 0;
  3042.  
  3043.     if (num_arg > 1)
  3044.         start = arg[1].u.number;
  3045.     if (num_arg == 3) {
  3046.         if (arg[2].type != T_NUMBER)
  3047.         bad_arg(2, instruction);
  3048.         len = arg[2].u.number;
  3049.     }
  3050.     i = print_file(arg[0].u.string, start, len);
  3051.     pop_n_elems(num_arg);
  3052.     push_number(i);
  3053.     break;
  3054.     }
  3055.     CASE(F_MKDIR);
  3056.     {
  3057.     char *path;
  3058.  
  3059. #ifdef COMPAT_MODE
  3060.     path = check_file_name(sp->u.string, 1);
  3061. #else
  3062.         path = check_valid_path(sp->u.string, current_object->eff_user, 
  3063.                                 "mkdir", 1);
  3064. #endif
  3065.     /* pop_stack(); marion - what the heck ??? */
  3066.     if (path == 0 || mkdir(path, 0770) == -1)
  3067.         assign_svalue(sp, &const0);
  3068.     else
  3069.         assign_svalue(sp, &const1);
  3070.     break;
  3071.     }
  3072.     CASE(F_RMDIR);
  3073.     {
  3074.     char *path;
  3075.  
  3076. #ifdef COMPAT_MODE
  3077.     path = check_file_name(sp->u.string, 1);
  3078. #else
  3079.     path = check_valid_path(sp->u.string, current_object->eff_user, 
  3080.                                 "rmdir", 1);
  3081. #endif
  3082.     /* pop_stack(); */
  3083.     if (path == 0 || rmdir(path) == -1)
  3084.         assign_svalue(sp, &const0);
  3085.     else
  3086.         assign_svalue(sp, &const1);
  3087.     break;
  3088.     }
  3089.     CASE(F_INPUT_TO);
  3090.     {
  3091.     struct svalue *arg = sp - num_arg + 1;
  3092.     int flag = 1;
  3093.     
  3094.     if (num_arg == 1 || sp->type == T_NUMBER && sp->u.number == 0)
  3095.         flag = 0;
  3096.     i = input_to(arg[0].u.string, flag);
  3097.     pop_n_elems(num_arg);
  3098.     push_number(i);
  3099.     break;
  3100.     }
  3101.     CASE(F_SET_LIVING_NAME);
  3102.     set_living_name(current_object, sp->u.string);
  3103.     break;
  3104.     CASE(F_PARSE_COMMAND);
  3105.     {
  3106.     struct svalue *arg;
  3107.  
  3108.     num_arg = EXTRACT_UCHAR(pc);
  3109.     pc++;
  3110.     arg = sp - num_arg + 1;
  3111.     if (arg[0].type != T_STRING)
  3112.         bad_arg(1, F_PARSE_COMMAND);
  3113.     if (arg[1].type != T_OBJECT && arg[1].type != T_POINTER)
  3114.         bad_arg(2, F_PARSE_COMMAND);
  3115.     if (arg[2].type != T_STRING)
  3116.         bad_arg(3, F_PARSE_COMMAND);
  3117.     if (arg[1].type == T_POINTER)
  3118.         check_for_destr(arg[1].u.vec);
  3119.  
  3120.     i = parse(arg[0].u.string, &arg[1], arg[2].u.string, &arg[3],
  3121.           num_arg-3); 
  3122.     pop_n_elems(num_arg);    /* Get rid of all arguments */
  3123.     push_number(i);        /* Push the result value */
  3124.     break;
  3125.     }
  3126.     CASE(F_SSCANF);
  3127.     num_arg = EXTRACT_UCHAR(pc);
  3128.     pc++;
  3129.     i = inter_sscanf(num_arg);
  3130.     pop_n_elems(num_arg);
  3131.     push_number(i);
  3132.     break;
  3133.     CASE(F_ENABLE_COMMANDS);
  3134.     enable_commands(1);
  3135.     push_number(1);
  3136.     break;
  3137.     CASE(F_DISABLE_COMMANDS);
  3138.     enable_commands(0);
  3139.     push_number(0);
  3140.     break;
  3141.     CASE(F_PRESENT);
  3142.     {
  3143.         struct svalue *arg = sp - num_arg + 1;
  3144.         ob = object_present(arg, num_arg == 1 ? 0 : arg[1].u.ob);
  3145.         pop_n_elems(num_arg);
  3146.         if (ob)
  3147.         push_object(ob, "F_PRESENT");
  3148.         else
  3149.         push_number(0);
  3150.     }
  3151.     break;
  3152.     CASE(F_SET_LIGHT);
  3153.     {
  3154.     struct object *o1;
  3155.  
  3156.     add_light(current_object, sp->u.number);
  3157.     o1 = current_object;
  3158.     while(o1->super)
  3159.         o1 = o1->super;
  3160.     sp->u.number = o1->total_light;
  3161.     break;
  3162.     }
  3163.     CASE(F_CONST0);
  3164.     push_number(0);
  3165.     break;
  3166.     CASE(F_CONST1);
  3167.     push_number(1);
  3168.     break;
  3169.     CASE(F_NUMBER);
  3170.     ((char *)&i)[0] = pc[0];
  3171.     ((char *)&i)[1] = pc[1];
  3172.     ((char *)&i)[2] = pc[2];
  3173.     ((char *)&i)[3] = pc[3];
  3174.     pc += 4;
  3175.     push_number(i);
  3176.     break;
  3177.     CASE(F_ASSIGN);
  3178. #ifdef DEBUG
  3179.     if (sp[-1].type != T_LVALUE)
  3180.         fatal("Bad argument to F_ASSIGN\n");
  3181. #endif
  3182.     assign_svalue((sp-1)->u.lvalue, sp);
  3183.     assign_svalue(sp-1, sp);
  3184.     pop_stack();
  3185.     break;
  3186.     CASE(F_CTIME);
  3187.     {
  3188.     char *cp, *a;
  3189.         int n = current_time;
  3190.         if (num_arg) { n = sp->u.number; pop_stack(); }
  3191.         cp = string_copy(time_string(n));
  3192.     /* Now strip the newline. */
  3193.     a = strchr(cp, '\n');
  3194.     if (a)
  3195.         *a = '\0';
  3196.     push_shared_string(make_shared_string(cp));
  3197.         free(cp);/*MALLOC*/
  3198.     break;
  3199.     }
  3200.     CASE(F_ADD_EQ);
  3201.     if (sp[-1].type != T_LVALUE)
  3202.        bad_arg(1, F_ADD_EQ);
  3203.     argp = sp[-1].u.lvalue;
  3204.     switch(argp->type) 
  3205.         {
  3206.            case T_POINTER:
  3207.        {
  3208.           struct vector *v;
  3209.           if (sp->type != T_POINTER)
  3210.          v = append_vector(argp->u.vec, sp);
  3211.           else 
  3212.                 v = add_array(argp->u.vec, sp->u.vec);
  3213.           pop_n_elems(2);
  3214.           push_vector(v);
  3215.           v->ref--;
  3216.           break;
  3217.            }
  3218.        case T_STRING:
  3219.        {
  3220.           char *new_str;
  3221.           switch(sp->type)
  3222.           {
  3223.              case T_STRING: { 
  3224.             new_str=xalloc(strlen(argp->u.string)+
  3225.                                    strlen(sp->u.string)+1);
  3226.             strcpy(new_str, argp->u.string);
  3227.             strcat(new_str, sp->u.string);
  3228.             pop_n_elems(2);
  3229.             push_shared_string(make_shared_string(new_str));
  3230.             free(new_str);/**MALLOC**/
  3231.             break;
  3232.          } 
  3233.          case T_NUMBER: {
  3234.             char buff[20];
  3235.             sprintf(buff, "%d", sp->u.number);
  3236.             new_str = xalloc(strlen(argp->u.string)+strlen(buff)+1);
  3237.             strcpy(new_str, argp->u.string);
  3238.             strcat(new_str, buff);
  3239.             pop_n_elems(2);
  3240.             push_shared_string(make_shared_string(new_str));
  3241.             free(new_str);/**MALLOC**/
  3242.             break;
  3243.          }
  3244.          case T_POINTER: {
  3245.             struct vector *v;
  3246.             v = prepend_vector(sp->u.vec, argp);
  3247.             pop_n_elems(2);
  3248.             push_vector(v);
  3249.             v->ref--;
  3250.             break;
  3251.          }
  3252.          default: error("Bad type RHS to +=\n");
  3253.           } 
  3254.        }
  3255.        break;
  3256.        case T_NUMBER: {
  3257.           switch(sp->type) 
  3258.           {
  3259.              case T_NUMBER:
  3260.             i = argp->u.number + sp->u.number;
  3261.             pop_n_elems(2);
  3262.             push_number(i);
  3263.             break;
  3264.              case T_POINTER:
  3265.              {
  3266.             struct vector *v;
  3267.             v = prepend_vector(sp->u.vec, argp);
  3268.             pop_n_elems(2);
  3269.             push_vector(v); /* This will make ref count == 2 */
  3270.             v->ref--;
  3271.             break;
  3272.          }
  3273.               case T_STRING: 
  3274.                  {
  3275.             char buff[20], *new_str;
  3276.             sprintf(buff, "%d", argp->u.number);
  3277.             new_str=xalloc(strlen(sp->u.string) + strlen(buff) + 1);
  3278.             strcpy(new_str, buff);
  3279.             strcat(new_str, sp->u.string);
  3280.             pop_n_elems(2);
  3281.             push_shared_string(make_shared_string(new_str));
  3282.             free(new_str);/**MALLOC**/
  3283.             break;
  3284.          }
  3285.          default:
  3286.             error("Bad type number to rhs +=.\n");
  3287.           }
  3288.        }
  3289.        break;
  3290.           default:
  3291.           error("Bad type to lhs +=");
  3292.     }
  3293.     assign_svalue(argp, sp);
  3294.     break;
  3295.     CASE(F_SUB_EQ);
  3296.     if (sp[-1].type != T_LVALUE)
  3297.         bad_arg(1, F_SUB_EQ);
  3298.     argp = sp[-1].u.lvalue;
  3299.         switch(argp->type)
  3300.         {
  3301.            case T_NUMBER:
  3302.           if (sp->type != T_NUMBER)
  3303.              error("Bad right type to -=\n");
  3304.           i = argp->u.number - sp->u.number;
  3305.           pop_n_elems(2);
  3306.           push_number(i);
  3307.               break;
  3308.            case T_POINTER:
  3309. #ifdef COMPAT_MODE
  3310.            {
  3311.               struct vector *v;
  3312.               v = subtract_array(argp->u.vec, sp);
  3313.               pop_n_elems(2);
  3314.               if (v) { push_vector(v); v->ref--; }
  3315.               else push_number(0);
  3316.               break;
  3317.            }
  3318. #else
  3319.       {
  3320.         struct vector *subtract_array PROT((struct vector*,struct vector*));
  3321.         struct vector *v;
  3322.  
  3323.         if (sp->type != T_POINTER)
  3324.             error("Bad right type to -=");
  3325.         v = sp->u.vec;
  3326.         if (v->ref > 1) {
  3327.         v = slice_array(v, 0, v->size-1 );
  3328.         v->ref--;
  3329.             }
  3330.         sp--;
  3331.         v = subtract_array(argp->u.vec, v);
  3332.         free_vector(argp->u.vec);
  3333.         argp->u.vec = v;
  3334.         break;
  3335.       }
  3336. #endif
  3337.            default: error("Bad lhs to -=\n");
  3338.         }
  3339.     assign_svalue(argp, sp);
  3340.     break;
  3341.     CASE(F_MULT_EQ);
  3342.     if (sp[-1].type != T_LVALUE)
  3343.         bad_arg(1, F_MULT_EQ);
  3344.     argp = sp[-1].u.lvalue;
  3345.     if (argp->type != T_NUMBER)
  3346.         error("Bad left type to *=.\n");
  3347.     if (sp->type != T_NUMBER)
  3348.         error("Bad right type to *=");
  3349.     i = argp->u.number * sp->u.number;
  3350.     pop_n_elems(2);
  3351.     push_number(i);
  3352.     assign_svalue(argp, sp);
  3353.     break;
  3354.     CASE(F_AND_EQ);
  3355.     if (sp[-1].type != T_LVALUE)
  3356.         bad_arg(1, F_AND_EQ);
  3357.     argp = sp[-1].u.lvalue;
  3358.     if (argp->type != T_NUMBER)
  3359.         error("Bad left type to &=.\n");
  3360.     if (sp->type != T_NUMBER)
  3361.         error("Bad right type to &=");
  3362.     i = argp->u.number & sp->u.number;
  3363.     pop_n_elems(2);
  3364.     push_number(i);
  3365.     assign_svalue(argp, sp);
  3366.     break;
  3367.     CASE(F_OR_EQ);
  3368.     if (sp[-1].type != T_LVALUE)
  3369.         bad_arg(1, F_OR_EQ);
  3370.     argp = sp[-1].u.lvalue;
  3371.     if (sp[-1].type != T_LVALUE)
  3372.         bad_arg(1, F_OR_EQ);
  3373.     argp = sp[-1].u.lvalue;
  3374.     if (argp->type != T_NUMBER)
  3375.         error("Bad left type to |=.\n");
  3376.     if (sp->type != T_NUMBER)
  3377.         error("Bad right type to |=");
  3378.     i = argp->u.number | sp->u.number;
  3379.     pop_n_elems(2);
  3380.     push_number(i);
  3381.     assign_svalue(argp, sp);
  3382.     break;
  3383.     CASE(F_XOR_EQ);
  3384.     if (sp[-1].type != T_LVALUE)
  3385.         bad_arg(1, F_XOR_EQ);
  3386.     argp = sp[-1].u.lvalue;
  3387.     if (argp->type != T_NUMBER)
  3388.         error("Bad left type to ^=.\n");
  3389.     if (sp->type != T_NUMBER)
  3390.         error("Bad right type to ^=");
  3391.     i = argp->u.number ^ sp->u.number;
  3392.     pop_n_elems(2);
  3393.     push_number(i);
  3394.     assign_svalue(argp, sp);
  3395.     break;
  3396.     CASE(F_LSH_EQ);
  3397.     if (sp[-1].type != T_LVALUE)
  3398.         bad_arg(1, F_LSH_EQ);
  3399.     argp = sp[-1].u.lvalue;
  3400.     if (argp->type != T_NUMBER)
  3401.         error("Bad left type to <<=.\n");
  3402.     if (sp->type != T_NUMBER)
  3403.         error("Bad right type to <<=");
  3404.     i = argp->u.number << sp->u.number;
  3405.     pop_n_elems(2);
  3406.     push_number(i);
  3407.     assign_svalue(argp, sp);
  3408.     break;
  3409.     CASE(F_RSH_EQ);
  3410.     if (sp[-1].type != T_LVALUE)
  3411.         bad_arg(1, F_RSH_EQ);
  3412.     argp = sp[-1].u.lvalue;
  3413.     if (argp->type != T_NUMBER)
  3414.         error("Bad left type to >>=.\n");
  3415.     if (sp->type != T_NUMBER)
  3416.         error("Bad right type to >>=");
  3417.     i = argp->u.number >> sp->u.number;
  3418.     pop_n_elems(2);
  3419.     push_number(i);
  3420.     assign_svalue(argp, sp);
  3421.     break;
  3422. #ifdef F_COMBINE_FREE_LIST
  3423.     CASE(F_COMBINE_FREE_LIST);
  3424. #ifdef MALLOC_malloc
  3425.     push_number(resort_free_list());
  3426. #else
  3427.     push_number(0);
  3428. #endif
  3429.     break;
  3430. #endif
  3431.     CASE(F_DIV_EQ);
  3432.     if (sp[-1].type != T_LVALUE)
  3433.         bad_arg(1, F_DIV_EQ);
  3434.     argp = sp[-1].u.lvalue;
  3435.     if (argp->type != T_NUMBER)
  3436.         error("Bad left type to /=.\n");
  3437.     if (sp->type != T_NUMBER)
  3438.         error("Bad right type to /=");
  3439.     if (sp->u.number == 0)
  3440.         error("Division by 0\n");
  3441.     i = argp->u.number / sp->u.number;
  3442.     pop_n_elems(2);
  3443.     push_number(i);
  3444.     assign_svalue(argp, sp);
  3445.     break;
  3446.     CASE(F_MOD_EQ);
  3447.     if (sp[-1].type != T_LVALUE)
  3448.         bad_arg(1, F_MOD_EQ);
  3449.     argp = sp[-1].u.lvalue;
  3450.     if (argp->type != T_NUMBER)
  3451.         error("Bad left type to %=.\n");
  3452.     if (sp->type != T_NUMBER)
  3453.         error("Bad right type to %=");
  3454.     if (sp->u.number == 0)
  3455.         error("Division by 0\n");
  3456.     i = argp->u.number % sp->u.number;
  3457.     pop_n_elems(2);
  3458.     push_number(i);
  3459.     assign_svalue(argp, sp);
  3460.     break;
  3461.     CASE(F_STRING);
  3462.     {
  3463.     unsigned short string_number;
  3464.     ((char *)&string_number)[0] = pc[0];
  3465.     ((char *)&string_number)[1] = pc[1];
  3466.     pc += 2;
  3467.     push_string(current_prog->strings[string_number],
  3468.             STRING_CONSTANT);
  3469.     break;
  3470.     }
  3471. #ifdef F_RUSAGE
  3472.     CASE(F_RUSAGE);
  3473.     {
  3474.         char buff[500];
  3475.  
  3476.     struct rusage rus;
  3477.     long utime, stime;
  3478.     int maxrss;
  3479.  
  3480.     if (getrusage(RUSAGE_SELF, &rus) < 0)
  3481.             buff[0] = 0;
  3482.     else {
  3483.         utime = rus.ru_utime.tv_sec * 1000 + rus.ru_utime.tv_usec / 1000;
  3484.         stime = rus.ru_stime.tv_sec * 1000 + rus.ru_stime.tv_usec / 1000;
  3485.         maxrss = rus.ru_maxrss;
  3486. #ifdef sun
  3487.         maxrss *= getpagesize() / 1024;
  3488. #endif
  3489.         sprintf(buff, "%ld %ld %d %d %d %d %d %d %d %d %d %d %d %d %d %d",
  3490.             utime, stime, maxrss, rus.ru_ixrss, rus.ru_idrss,
  3491.             rus.ru_isrss, rus.ru_minflt, rus.ru_majflt, rus.ru_nswap,
  3492.             rus.ru_inblock, rus.ru_oublock, rus.ru_msgsnd, 
  3493.             rus.ru_msgrcv, rus.ru_nsignals, rus.ru_nvcsw, 
  3494.             rus.ru_nivcsw);
  3495.       }
  3496.     push_string(buff, STRING_SHARED);
  3497.     break;
  3498.     }
  3499. #endif
  3500.     CASE(F_CINDENT);
  3501.     {
  3502.     char *path;
  3503.  
  3504. #ifndef COMPAT_MODE
  3505.         path = check_valid_path(sp->u.string, current_object->eff_user, "cindent", 1); 
  3506. #else
  3507.         path = check_file_name(sp->u.string, 1);
  3508. #endif
  3509.     pop_stack();
  3510.     if (path) {
  3511.         if (indent_program(path)) {
  3512.         push_number(1);
  3513.         break;
  3514.         }
  3515.     } else {
  3516.         add_message("Illegal attempt to indent\n");
  3517.     }
  3518.     push_number(0);
  3519.     break;
  3520.     }
  3521.     CASE(F_DESCRIBE);
  3522.     {
  3523.     char *str;
  3524.     int live;
  3525.  
  3526.     if (num_arg < 3) live = 0;
  3527.     else {
  3528.         if (sp->type != T_NUMBER) bad_arg (3, F_DESCRIBE);
  3529.         live = sp->u.number;
  3530.         pop_stack ();
  3531.     }
  3532.     str = describe_items(sp-1, sp->u.string, live);
  3533.     pop_n_elems(2);
  3534.     if (str) push_shared_string (make_shared_string(str));
  3535.     else     push_number(0);
  3536.     break;
  3537.     }
  3538.     CASE(F_UNIQUE_ARRAY); {
  3539.     extern struct vector 
  3540.         *make_unique PROT((struct vector *arr,char *func,
  3541.                 struct svalue *skipnum));
  3542.     struct vector *res;
  3543.  
  3544.     if (num_arg < 3) 
  3545.         res = make_unique((sp-1)->u.vec, sp->u.string, &const0);
  3546.     else {
  3547.         res = make_unique ((sp-2)->u.vec, (sp-1)->u.string, sp);
  3548.         pop_stack ();
  3549.     }
  3550.         pop_n_elems(2);
  3551.         if (res) { push_vector(res); res->ref--; }
  3552.         else     push_number(0);
  3553.     break;
  3554.     }
  3555.     CASE(F_VERSION); {
  3556.     char buff[12];
  3557.     sprintf(buff, "%5.5s%2d-DR", GAME_VERSION, PATCH_LEVEL);
  3558.     push_string(buff, STRING_SHARED);
  3559.     break;
  3560.     }
  3561.     CASE(F_MAP_ARRAY); {
  3562.     struct vector *res;
  3563.     struct svalue *arg;
  3564.  
  3565.     arg = sp - num_arg + 1; ob = 0;
  3566.  
  3567.     if (arg[2].type == T_OBJECT) 
  3568.         ob = arg[2].u.ob;
  3569.         else if (arg[2].type == T_STRING)
  3570.             ob = find_object(arg[2].u.string);
  3571.  
  3572.         if (!ob)
  3573.             bad_arg (3, F_MAP_ARRAY);
  3574.     if (arg[0].type == T_POINTER)
  3575.         res = map_array (arg[0].u.vec, arg[1].u.string, ob,
  3576.                  num_arg > 3 ? sp : (struct svalue *)0);
  3577.     else
  3578.         res = 0;
  3579.     pop_n_elems (num_arg);
  3580.     if (res) { push_vector (res); sp->u.vec->ref--; }
  3581.     else     push_number (0);
  3582.     break;
  3583.     }
  3584.     /*  ADDED -- 5-91  Raistlin -- Americanized standard LP */
  3585. /*
  3586.     CASE(F_REMOVE_LIVING_NAME)
  3587.        remove_one_living_name(sp->u.string, current_object);
  3588.        break; 
  3589. */
  3590.     CASE(F_ROOT);
  3591.     { 
  3592.        struct object *obj = current_object;
  3593.        int i;
  3594.        if (num_arg == 1)
  3595.           obj = sp->u.ob;
  3596.        i = (strchr(obj->name, '#') == NULL);
  3597.        pop_n_elems(num_arg);
  3598.        push_number(i);
  3599.        break;
  3600.     } 
  3601.     CASE(F_DELETEA);
  3602.     {
  3603.        struct svalue *arg = sp - num_arg + 1;
  3604.        struct vector *ret;
  3605.        int j = arg[1].u.number;
  3606.        
  3607.        if (num_arg == 3)
  3608.        {
  3609.           if (arg[2].type != T_NUMBER)
  3610.              bad_arg(3, F_DELETEA);
  3611.           j = arg[2].u.number;
  3612.        }
  3613.        ret = delete_elements(arg[0].u.vec, arg[1].u.number, j);
  3614.        pop_n_elems(num_arg);
  3615.        if (ret) { push_vector(ret); ret->ref--; }
  3616.        else push_number(0);
  3617.        break;
  3618.     }
  3619.     CASE(F_EXISTS);
  3620.     {
  3621.        struct stat st;
  3622.        int offset = 0;
  3623.        char *file = sp->u.string;
  3624.        if (*file == '/') offset = 1;
  3625.        pop_stack();
  3626.        if (stat(file+offset, &st) != -1)
  3627.           push_number(1);
  3628.        else push_number(0);
  3629.        break;
  3630.     }
  3631.     CASE(F_PAD);
  3632.     {
  3633.         struct svalue *arg = sp-num_arg+1;
  3634.         char *new, *str, numbuf[20];
  3635.         int len = arg[1].u.number, strl;
  3636.         int right_justify = 0, padchar = ' ';
  3637.          
  3638.         if (num_arg == 3)
  3639.         {
  3640.        if (arg[2].type != T_NUMBER)
  3641.               bad_arg(3, F_PAD);
  3642.            padchar = arg[2].u.number;
  3643.         }
  3644.         if (arg[0].type == T_NUMBER)
  3645.         {
  3646.            sprintf(numbuf, "%d", arg[0].u.number);
  3647.            str = numbuf;
  3648.         } 
  3649.         else
  3650.            str = arg[0].u.string;
  3651.  
  3652.  
  3653.         if (len < 0)
  3654.         {
  3655.            len = -len;
  3656.            right_justify = 1;
  3657.         }
  3658.  
  3659.         if (len == 0)
  3660.         {
  3661.            /* Nothing to pad!! */
  3662.            pop_n_elems(num_arg);
  3663.            push_constant_string("");
  3664.            break;
  3665.         }
  3666.  
  3667.         strl = strlen(str);
  3668.         if (strl > len) strl = len;
  3669.         new = xalloc(len+1);
  3670.         
  3671.         if (right_justify)
  3672.         { 
  3673.            memset(new, padchar, len);
  3674.            if (strl)
  3675.                strncpy(new+len-strl, str, strl);
  3676.         }
  3677.         else
  3678.         {
  3679.            if (strl)
  3680.               strncpy(new, str, len);
  3681.            if (strl < len)
  3682.               memset(new+strl, padchar, len-strl);
  3683.         }
  3684.         new[len] = '\0';
  3685.         pop_n_elems(num_arg);
  3686.         push_shared_string(make_shared_string(new));
  3687.         free(new);
  3688.         break;
  3689.     } 
  3690.     CASE(F_REMOTE_COMMAND);
  3691.        push_number(remote_command);
  3692.        break;
  3693.     CASE(F_IN_EDITOR);
  3694.     {
  3695.         struct object *a = command_giver;
  3696.         if (num_arg==1) 
  3697.         {
  3698.            a = sp->u.ob;
  3699.            pop_stack();
  3700.         }
  3701.         if (a && a->interactive && a->interactive->ed_buffer)
  3702.            push_number(1);
  3703.         else 
  3704.            push_number(0);
  3705.         break;
  3706.     } 
  3707.     CASE(F_GRAB_FILE);
  3708.     {
  3709.     struct svalue *arg = sp - num_arg + 1;
  3710.         int start=0, len=0;
  3711.         struct vector *r;
  3712.  
  3713.         if (num_arg > 1)
  3714.            start = arg[1].u.number;
  3715.         if (num_arg == 3)
  3716.            len = arg[2].u.number; 
  3717.  
  3718.         r = grab_file(arg[0].u.string, start, len);
  3719.         pop_n_elems(num_arg);
  3720.         if (r) { push_vector(r); sp->u.vec->ref--; }
  3721.         else push_number(0);
  3722.         break;
  3723.     }
  3724.     CASE(F_FILES);
  3725.     {
  3726.         struct vector *r;
  3727.  
  3728.         r = get_files(sp->u.string);
  3729.         pop_stack();
  3730.         if (r) { push_vector(r); sp->u.vec->ref--; }
  3731.         else   push_number(0);
  3732.         break;
  3733.     }
  3734. #ifdef F_POSSESSIVE
  3735.     CASE(F_POSSESSIVE);
  3736.     {
  3737.         struct object *obj = command_giver;
  3738.  
  3739.         if (num_arg == 1) obj = sp->u.ob;
  3740.         pop_n_elems(num_arg);
  3741.         if (!obj || obj->flags & O_DESTRUCTED)
  3742.            push_number(0);
  3743.         else
  3744.         {
  3745.            struct svalue *r = sapply("query_gender", obj, 0);
  3746.            if (!r || r->type != T_STRING)
  3747.               push_constant_string("its");
  3748.            else
  3749.            {
  3750.               if (!strcmp(r->u.string, "male"))
  3751.                  push_constant_string("his");
  3752.               else if (!strcmp(r->u.string, "female"))
  3753.                  push_constant_string("her");
  3754.               else push_constant_string("its");
  3755.            }
  3756.         }
  3757.         break;
  3758.     }
  3759. #endif
  3760. #ifdef F_OBJECTIVE
  3761.     CASE(F_OBJECTIVE);
  3762.     {
  3763.         struct object *obj;
  3764.  
  3765.         if (num_arg == 1) obj = sp->u.ob;
  3766.         else obj = command_giver;
  3767.         pop_n_elems(num_arg);
  3768.         if (!obj || obj->flags & O_DESTRUCTED)
  3769.            push_number(0);
  3770.         else
  3771.         {
  3772.            struct svalue *r = sapply("query_gender", obj, 0);
  3773.            if (!r || r->type != T_STRING)
  3774.               push_constant_string("it");
  3775.            else
  3776.            {
  3777.               if (!strcmp(r->u.string, "male"))
  3778.                  push_constant_string("him");
  3779.               else if (!strcmp(r->u.string, "female"))
  3780.                  push_constant_string("her");
  3781.               else push_constant_string("it");
  3782.            }
  3783.         }
  3784.         break;
  3785.     }
  3786. #endif
  3787. #ifdef F_SUBJECTIVE
  3788.     CASE(F_SUBJECTIVE);
  3789.     {
  3790.         struct object *obj;
  3791.  
  3792.         if (num_arg == 1) obj = sp->u.ob;
  3793.         else obj = command_giver;
  3794.         pop_n_elems(num_arg);
  3795.         if (!obj || obj->flags & O_DESTRUCTED)
  3796.            push_number(0);
  3797.         else
  3798.         {
  3799.            struct svalue *r = sapply("query_gender", obj, 0);
  3800.            if (!r || r->type != T_STRING)
  3801.               push_constant_string("it");
  3802.            else
  3803.            {
  3804.               if (!strcmp(r->u.string, "male"))
  3805.                  push_constant_string("he");
  3806.               else if (!strcmp(r->u.string, "female"))
  3807.                  push_constant_string("she");
  3808.               else push_constant_string("it");
  3809.            }
  3810.         }
  3811.         break;
  3812.     }
  3813. #endif
  3814.     CASE(F_REMOVE_INTERACTIVE)
  3815.         remove_interactive_player(sp->u.ob);
  3816.         break;
  3817.     CASE(F_CP)
  3818.     {
  3819.         int i;
  3820.         i = copy_file((sp-1)->u.string, sp->u.string);
  3821.         pop_n_elems(2);
  3822.         push_number(i);
  3823.         break;
  3824.     } 
  3825.     CASE(F_RENAME);
  3826.     {
  3827.         int i;
  3828.  
  3829.         i = rename_file((sp-1)->u.string, sp->u.string);
  3830.         pop_n_elems(2);
  3831.         push_number(i);
  3832.         break;
  3833.     }
  3834.     CASE(F_TYPEOF);
  3835.     {
  3836.        char *ret;
  3837.        int t;
  3838.  
  3839.        t = sp->type;
  3840.        pop_stack();
  3841.        switch(t) {
  3842.        case T_OBJECT:
  3843.           ret = "object";
  3844.           break;
  3845.        case T_NUMBER:
  3846.           ret = "int";
  3847.           break;
  3848.        case T_POINTER:
  3849.           ret = "vector";
  3850.           break;
  3851.        case T_STRING:
  3852.           ret = "string";
  3853.           break;
  3854.        default: ret = "";
  3855.        }
  3856.        push_constant_string(ret);
  3857.        break;
  3858.     } 
  3859.     CASE(F_CALLER);
  3860.     {
  3861.        struct object *o = caller();
  3862.  
  3863.        if (o)
  3864.           push_object(o, "F_CALLER");
  3865.        else push_number(0);
  3866.        break;
  3867.     }
  3868.     CASE(F_READ_FILE);
  3869.     {
  3870.     char *str;
  3871.     struct svalue *arg = sp- num_arg + 1;
  3872.     int start = 0, len = 0;
  3873.  
  3874.     if (num_arg > 1)
  3875.         start = arg[1].u.number;
  3876.     if (num_arg == 3) 
  3877.         {
  3878.         if (arg[2].type != T_NUMBER)
  3879.             bad_arg(2, instruction);
  3880.         len = arg[2].u.number;
  3881.         }
  3882.         /* back compatibility with American versions */
  3883. #ifdef COMPAT_MODE
  3884.         else if (num_arg == 2) 
  3885.            len = 1;  
  3886. #endif
  3887.  
  3888.     str = read_file(arg[0].u.string, start, len);
  3889.     pop_n_elems(num_arg);
  3890.     if (str == 0)
  3891.         push_number(0);
  3892.     else {
  3893.         push_string(str, STRING_MALLOC);
  3894.         free(str);
  3895.     }
  3896.     break;
  3897.     }
  3898.     CASE(F_INTERACTIVE)
  3899.     {
  3900.         int ret;
  3901.         if (sp->u.ob->flags&O_DESTRUCTED)
  3902.            ret = 0;
  3903.         else if (sp->u.ob->interactive) 
  3904.            ret = 1;
  3905.         else ret = 0;
  3906.         pop_stack();
  3907.         push_number(ret);
  3908.         break;
  3909.     }
  3910.     CASE(F_FIND_CALL_OUT);
  3911.     {
  3912.             int ret;
  3913.         ret = find_call_out(current_object, sp->u.string);
  3914.             pop_stack();
  3915.             push_number(ret);
  3916.         break;
  3917.     }
  3918.     CASE(F_MEMBER_ARRAY)
  3919.     {
  3920.        int ret;
  3921.        ret = search_array(sp, sp-1, 0);
  3922.        pop_n_elems(2);
  3923.        push_number(ret);
  3924.        break;
  3925.     }
  3926.     CASE(F_SEARCHA);
  3927.     case F_INDEX:
  3928.         {
  3929.             int ret;
  3930.             if (num_arg == 3)
  3931.             {
  3932.          if (sp->type != T_NUMBER)
  3933.              error("Bad argument number 3 to searcha.\n");
  3934.              ret = search_array((sp-2), (sp-1), sp->u.number);
  3935.             }
  3936.             else
  3937.                 ret = search_array((sp-1), sp, 0);
  3938.         pop_n_elems(num_arg);
  3939.             push_number(ret);
  3940.             break;
  3941.      }
  3942.     CASE(F_REALLOCATE);
  3943.         {
  3944.            struct vector *v;
  3945.  
  3946.            v = reallocate_array((sp-1)->u.vec, sp->u.number);
  3947.            pop_n_elems(2);
  3948.            push_vector(v);
  3949.            sp->u.vec->ref--;
  3950.         }
  3951.         break;
  3952.     CASE(F_MEMUSED);    /* Render 2/6/91 */
  3953.         push_number((int)memused()); 
  3954.     break;
  3955. /* 
  3956. ** modified 3/30/91 Raistlin add_attribute, query_attribute, 
  3957. ** delete_attribute, get_attribute, add_prot_attribute, format, and print 
  3958.  */
  3959.     CASE(F_GET_ATTRIBUTE); {
  3960.    /* arguments  get_attribute(string, object)  
  3961.    **               returns value associated with string 
  3962.    **            get_attribute(object)
  3963.    **               returns an array of all attributes associated with object 
  3964.    **   low level split into get_attr_vector and get_attribute
  3965.     */
  3966.           struct vector *v;
  3967.           int ret;
  3968.       char *attr = NULL;
  3969.           struct object *o = current_object;
  3970.           
  3971.           if (num_arg == 0 || (num_arg == 1 && sp->type == T_OBJECT &&
  3972.               (o = sp->u.ob))) /* yes, I want a single equal here */ 
  3973.           {
  3974.              v = get_attr_vector(o);
  3975.              pop_n_elems(num_arg);
  3976.              push_vector(v);
  3977.              sp->u.vec->ref--;
  3978.              break;
  3979.           }
  3980.           else 
  3981.           {
  3982.              if (num_arg == 2) 
  3983.              {
  3984.                 attr = (sp-1)->u.string;
  3985.                 o = sp->u.ob; 
  3986.              }
  3987.              else attr = sp->u.string;
  3988.              ret = get_attribute(attr, o);
  3989.              pop_n_elems(num_arg);
  3990.              push_number(ret);
  3991.           }
  3992.        }
  3993.        break;
  3994.     CASE(F_DELETE_ATTRIBUTE);
  3995.        {
  3996.           struct object *o;
  3997.           char *attr;
  3998.           
  3999.           if (num_arg == 2) 
  4000.           {
  4001.              o = sp->u.ob;
  4002.              attr = (sp-1)->u.string;
  4003.           }
  4004.           else 
  4005.           {
  4006.              o = current_object;
  4007.              attr = sp->u.string;
  4008.           }
  4009.           delete_attribute(attr, o);
  4010.           pop_n_elems(num_arg-1); /* delete is void, leave a return value */
  4011.        }
  4012.        break;
  4013.     case F_ADD_PROT_ATTRIBUTE:
  4014.     CASE(F_ADD_ATTRIBUTE);
  4015.        {
  4016.           struct object *t=current_object;
  4017.           char *attr; 
  4018.       int val = 1; 
  4019.           char *c=(instruction==F_ADD_ATTRIBUTE?
  4020.                    "add_attribute":"add_prot_attribute");
  4021.  
  4022.           if (num_arg == 3)
  4023.           {
  4024.              if (sp->type != T_OBJECT)
  4025.                 error("Bad type argument 3 to %s()\n", c);
  4026.              if ((sp-1)->type != T_NUMBER)
  4027.                 error("Bad type argument 2 to %s()\n", c);
  4028.              t = sp->u.ob;
  4029.              val = (sp-1)->u.number;
  4030.              attr = (sp-2)->u.string;
  4031.           }
  4032.           else if (num_arg == 2)
  4033.           {
  4034.              if (sp->type == T_OBJECT)
  4035.                 t = sp->u.ob;
  4036.              else val = sp->u.number;
  4037.              attr = (sp-1)->u.string;
  4038.           } 
  4039.           else attr = sp->u.string;
  4040.           add_attribute(attr, t, val, instruction == F_ADD_PROT_ATTRIBUTE);
  4041.           pop_n_elems(num_arg-1); /* add is void */
  4042.        }
  4043.        break;
  4044.     CASE(F_QUERY_ATTRIBUTE);
  4045.        {
  4046.           char *attr;
  4047.           int ret;
  4048.           struct object *o=current_object;
  4049.           
  4050.           if (num_arg == 2)
  4051.           {
  4052.              attr = (sp-1)->u.string;
  4053.              o = sp->u.ob;
  4054.           }
  4055.           else attr = sp->u.string;
  4056.           ret = query_attribute(attr, o);
  4057.           pop_n_elems(num_arg);
  4058.           push_number(ret);
  4059.        }
  4060.        break;
  4061.     case F_FORMAT:
  4062.     {
  4063.             char *c, *txt;
  4064.             int width=0;
  4065.  
  4066.             if (num_arg == 2)
  4067.             {
  4068.                width = sp->u.number;
  4069.                txt = (sp-1)->u.string;
  4070.             }
  4071.             else txt = sp->u.string;
  4072. /*
  4073.             if (width > TEXT_WIDTH)
  4074.                error("Invalid size for argument 2 to text()\n");
  4075. */
  4076.             
  4077.             c = textformat(txt, width);
  4078.             if (!c)
  4079.                error("Error formatting arg 1 to format()\n");
  4080.  
  4081.             pop_n_elems(num_arg);
  4082.             push_string(c, STRING_SHARED);
  4083.          }
  4084.          break;
  4085.     CASE(F_PRINT);
  4086.     {
  4087.             char *txt;
  4088.             int width = 0;
  4089.             char *c;
  4090.             struct svalue v;
  4091.             
  4092.             if (num_arg == 2)
  4093.             {
  4094.                txt = (sp-1)->u.string;
  4095.                width = sp->u.number;
  4096.             }
  4097.             else
  4098.                txt = sp->u.string; 
  4099.             if (width > TEXT_WIDTH)
  4100.             {
  4101.                error("Invalid size for argument 2 to print()\n");
  4102.                exit(1);
  4103.             }
  4104.             c = textformat(txt, width);
  4105.             if (!c)
  4106.             {
  4107.                error("Error formatting arg 1 to print()\n");
  4108.                exit(1);
  4109.             }
  4110.             v.u.string = c;
  4111.             v.type = T_STRING;
  4112.             v.string_type = STRING_CONSTANT;
  4113.             (void)do_write(&v);
  4114.             pop_n_elems(num_arg-1); /* void */
  4115.             break;
  4116.      }
  4117.     CASE(F_SORT_ARRAY); {
  4118.     extern struct vector *sort_array
  4119.       PROT((struct vector*,char *,struct object *));
  4120.     struct vector *res;
  4121.     struct svalue *arg;
  4122.  
  4123.     arg = sp - 2; ob = 0;
  4124.  
  4125.     if (arg[2].type == T_OBJECT)
  4126.         ob = arg[2].u.ob;
  4127.     else if (arg[2].type == T_STRING) 
  4128.         ob = find_object(arg[2].u.string);
  4129.  
  4130.     if (!ob)
  4131.         bad_arg (3, F_SORT_ARRAY);
  4132.  
  4133.     if (arg[0].type == T_POINTER)
  4134.         /* sort_array already takes care of destructed objects */
  4135.         res = sort_array (
  4136.           slice_array(arg[0].u.vec, 0, arg[0].u.vec->size-1),
  4137.           arg[1].u.string, ob);
  4138.     else
  4139.         res = 0;
  4140.     pop_n_elems (3);
  4141.     sp++;
  4142.     if (res) {
  4143.         sp->type = T_POINTER;
  4144.         sp->u.vec = res;
  4145.     }
  4146.     else     *sp = const0;
  4147.     break;
  4148.     }
  4149. CASE(F_ORDER_ALIST);
  4150.     {
  4151.     extern struct vector *order_alist PROT((struct vector *));
  4152.     struct svalue *args;
  4153.     struct vector *list;
  4154.     int listsize,keynum;
  4155.  
  4156.     if (num_arg == 1 && sp->u.vec->size 
  4157.           && sp->u.vec->item[0].type == T_POINTER) {
  4158.             args     = sp->u.vec->item;
  4159.         listsize = sp->u.vec->size;
  4160.     } else {
  4161.         args = sp-num_arg+1;
  4162.         listsize = num_arg;
  4163.     }
  4164.     keynum = args[0].u.vec->size;
  4165.     list = allocate_array(listsize);
  4166.     for (i=0; i<listsize; i++) {
  4167.         if (args[i].type != T_POINTER
  4168.          || args[i].u.vec->size != keynum) {
  4169.         free_vector(list);
  4170.         error("bad data array %d in call to order_alist",i);
  4171.         }
  4172.         list->item[i].type = T_POINTER;
  4173.         list->item[i].u.vec = slice_array(args[i].u.vec,0,keynum-1);
  4174.         }
  4175.         pop_n_elems(num_arg);
  4176.     sp++;
  4177.     sp->type = T_POINTER;
  4178.         sp->u.vec = order_alist(list);
  4179.     free_vector(list);
  4180.         break;
  4181.     }
  4182. CASE(F_INSERT_ALIST)
  4183.     {
  4184.     /* When the key list of an alist contains destructed objects
  4185.        it is better not to free them till the next reordering by
  4186.        order_alist to retain the alist property.
  4187.      */
  4188.     extern struct svalue *insert_alist
  4189.       PROT((struct svalue *key,struct svalue *key_data,
  4190.         struct vector *list));
  4191.     struct vector *list;
  4192.     int listsize,keynum;
  4193.     struct svalue *key,*key_data,*ret;
  4194.     static struct vector tempvec = { 1,1, };
  4195.  
  4196.     if (sp->type != T_POINTER)
  4197.         bad_arg(num_arg,F_INSERT_ALIST);
  4198.     if ( !(listsize = sp->u.vec->size) ||
  4199.       sp->u.vec->item[0].type != T_POINTER ) {
  4200.         list = &tempvec;
  4201.         assign_svalue_no_free(list->item,sp);
  4202.         listsize = 1;
  4203.     } else
  4204.         list = sp->u.vec;
  4205.     keynum = list->item[0].u.vec->size;
  4206.     for (i=1; i<listsize; i++) {
  4207.         if (list->item[i].type != T_POINTER
  4208.           ||list->item[i].u.vec->size != keynum)
  4209.         bad_arg(num_arg,F_INSERT_ALIST);
  4210.     }
  4211.     if (num_arg == 2) {
  4212.         if (sp[-1].type != T_POINTER) {
  4213.         key_data = (struct svalue*)NULL;
  4214.         key = sp-1;
  4215.         } else {
  4216.             if (sp[-1].u.vec->size != listsize)
  4217.             bad_arg(1,F_INSERT_ALIST);
  4218.             key_data = key = sp[-1].u.vec->item;
  4219.         }
  4220.     } else {
  4221.         if (num_arg - 1 != listsize)
  4222.         bad_arg(1,F_INSERT_ALIST);
  4223.             key_data = key = sp-num_arg+1;
  4224.     }
  4225.     ret = insert_alist(key,key_data,list);
  4226.     pop_n_elems(num_arg);
  4227.     sp++;
  4228.     *sp = *ret;
  4229.     break;
  4230.     }
  4231. CASE(F_ASSOC);
  4232.     {
  4233.     /* When the key list of an alist contains destructed objects
  4234.        it is better not to free them till the next reordering by
  4235.        order_alist to retain the alist property.
  4236.      */
  4237.     int assoc PROT((struct svalue *key, struct vector *keys));
  4238.     struct svalue *args = sp -num_arg +1;
  4239.     struct vector *keys,*data;
  4240.     struct svalue *fail_val;
  4241.     int ix;
  4242.  
  4243.     if ( !args[1].u.vec->size ||
  4244.       args[1].u.vec->item[0].type != T_POINTER ) {
  4245.         keys = args[1].u.vec;
  4246.         if (num_arg == 2) {
  4247.         data = (struct vector *)NULL;
  4248.         } else {
  4249.         if (args[2].type != T_POINTER ||
  4250.           args[2].u.vec->size != keys->size) {
  4251.             bad_arg(3,F_ASSOC);
  4252.         }
  4253.         data = args[2].u.vec;
  4254.         }
  4255.         if (num_arg == 4) {
  4256.         fail_val = &args[3];
  4257.         } else {
  4258.         fail_val = &const0;
  4259.         }
  4260.     } else {
  4261.         keys = args[1].u.vec->item[0].u.vec;
  4262.         if (args[1].u.vec->size > 1) {
  4263.         if (args[1].u.vec->item[1].type != T_POINTER ||
  4264.             args[1].u.vec->item[1].u.vec->size != keys->size) {
  4265.             bad_arg(2,F_ASSOC);
  4266.             }
  4267.         data = args[1].u.vec->item[1].u.vec;
  4268.         } else {
  4269.         data = (struct vector *)NULL;
  4270.         }
  4271.         if (num_arg == 3) fail_val = &args[2];
  4272.         else if (num_arg == 2) fail_val = &const0;
  4273.         else {
  4274.         error ("Too many args to efun assoc().\n");
  4275.         }
  4276.     }
  4277.     ix = assoc(&args[0],keys);
  4278.     if (data == (struct vector *)NULL) {
  4279.         pop_n_elems(num_arg);
  4280.         push_number(ix);
  4281.     } else {
  4282.         assign_svalue(args, ix==-1 ? fail_val : &data->item[ix]);
  4283.         pop_n_elems(num_arg-1);
  4284.     }
  4285.         break;
  4286.     }
  4287. CASE(F_INTERSECT_ALIST);
  4288.     {
  4289.     extern struct vector *intersect_alist
  4290.       PROT((struct vector *, struct vector *));
  4291.     struct vector *tmp = intersect_alist( (sp-1)->u.vec, sp->u.vec );
  4292.     pop_stack();
  4293.     free_vector(sp->u.vec);
  4294.     sp->u.vec = tmp;
  4295.     }
  4296. CASE(F_DEBUG_INFO);
  4297.     {
  4298.     struct svalue *arg = sp-num_arg+1;
  4299.     struct svalue res;
  4300.  
  4301.     switch ( arg[0].u.number ) {
  4302.         case 0:
  4303.         {
  4304.         int flags;
  4305.         struct object *obj2;
  4306.  
  4307.         if (num_arg != 2)
  4308.                 error("bad number of arguments to debug_info");
  4309.         if ( arg[1].type != T_OBJECT)
  4310.             bad_arg(1,instruction);
  4311.         ob = arg[1].u.ob;
  4312.         flags = ob->flags;
  4313.         add_message("O_HEART_BEAT      : %s\n",
  4314.           flags&O_HEART_BEAT      ?"TRUE":"FALSE");
  4315.         add_message("O_IS_WIZARD       : %s\n",
  4316.           flags&O_IS_WIZARD       ?"TRUE":"FALSE");
  4317.         add_message("O_ENABLE_COMMANDS : %s\n",
  4318.           flags&O_ENABLE_COMMANDS ?"TRUE":"FALSE");
  4319.         add_message("O_CLONE           : %s\n",
  4320.           flags&O_CLONE           ?"TRUE":"FALSE");
  4321.         add_message("O_DESTRUCTED      : %s\n",
  4322.           flags&O_DESTRUCTED      ?"TRUE":"FALSE");
  4323.         add_message("O_SWAPPED         : %s\n",
  4324.           flags&O_SWAPPED          ?"TRUE":"FALSE");
  4325.         add_message("O_ONCE_INTERACTIVE: %s\n",
  4326.           flags&O_ONCE_INTERACTIVE?"TRUE":"FALSE");
  4327.         add_message("O_APPROVED        : %s\n",
  4328.           flags&O_APPROVED        ?"TRUE":"FALSE");
  4329.         add_message("O_RESET_STATE     : %s\n",
  4330.           flags&O_RESET_STATE     ?"TRUE":"FALSE");
  4331.         add_message("O_WILL_CLEAN_UP   : %s\n",
  4332.           flags&O_WILL_CLEAN_UP   ?"TRUE":"FALSE");
  4333.             add_message("total light : %d\n", ob->total_light);
  4334.         add_message("next_reset  : %d\n", ob->next_reset);
  4335.         add_message("time_of_ref : %d\n", ob->time_of_ref);
  4336.         add_message("ref         : %d\n", ob->ref);
  4337. #ifdef DEBUG
  4338.         add_message("extra_ref   : %d\n", ob->extra_ref);
  4339. #endif
  4340.         add_message("swap_num    : %ld\n", ob->swap_num);
  4341.         add_message("name        : '%s'\n", ob->name);
  4342.         add_message("next_all    : OBJ(%s)\n",
  4343.           ob->next_all?ob->next_all->name:"NULL");
  4344.         if (obj_list == ob) add_message(
  4345.             "This object is the head of the object list.\n");
  4346.         for (obj2=obj_list,i=1; obj2; obj2=obj2->next_all,i++)
  4347.             if (obj2->next_all == ob) {
  4348.             add_message(
  4349.                 "Previous object in object list: OBJ(%s)\n",
  4350.                 obj2->name);
  4351.             add_message("position in object list:%d\n",i);
  4352.             }
  4353.         assign_svalue_no_free(&res,&const0);
  4354.         break;
  4355.         }
  4356.         case 1: {
  4357.         if (num_arg != 2)
  4358.                 error("bad number of arguments to debug_info");
  4359.         if ( arg[1].type != T_OBJECT)
  4360.             bad_arg(1,instruction);
  4361.         ob = arg[1].u.ob;
  4362.         
  4363.         add_message("program ref's %d\n", ob->prog->ref);
  4364.         add_message("Name %s\n", ob->prog->name);
  4365.         add_message("program size %d\n",
  4366.         ob->prog->program_size);
  4367.         add_message("num func's %d (%d) \n", ob->prog->num_functions
  4368.         ,ob->prog->num_functions * sizeof(struct function));
  4369.         add_message("num strings %d\n", ob->prog->num_strings);
  4370.         add_message("num vars %d (%d)\n", ob->prog->num_variables
  4371.         ,ob->prog->num_variables * sizeof(struct variable));
  4372.         add_message("num inherits %d (%d)\n", ob->prog->num_inherited
  4373.         ,ob->prog->num_inherited * sizeof(struct inherit));
  4374.         add_message("total size %d\n", ob->prog->total_size);
  4375.         assign_svalue_no_free(&res,&const0);
  4376.         break;
  4377.         }
  4378.         default: bad_arg(1,instruction);
  4379.     }
  4380.     pop_n_elems(num_arg);
  4381.     sp++;
  4382.     *sp=res;
  4383.     break;
  4384.     }
  4385.     }
  4386. #ifdef DEBUG
  4387.     if (expected_stack && expected_stack != sp ||
  4388.     sp < fp + csp->num_local_variables - 1)
  4389.     {
  4390.     fatal("Bad stack after evaluation. Instruction %d, num arg %d\n",
  4391.           instruction, num_arg);
  4392.     }
  4393. #endif /* DEBUG */
  4394.     goto again;
  4395. }
  4396.  
  4397. /*
  4398.  * Apply a fun 'fun' to the program in object 'ob', with
  4399.  * 'num_arg' arguments (already pushed on the stack).
  4400.  * If the function is not found, search in the object pointed to by the
  4401.  * inherit pointer.
  4402.  * If the function name starts with '::', search in the object pointed out
  4403.  * through the inherit pointer by the current object. The 'current_object'
  4404.  * stores the base object, not the object that has the current function being
  4405.  * evaluated. Thus, the variable current_prog will normally be the same as
  4406.  * current_object->prog, but not when executing inherited code. Then,
  4407.  * it will point to the code of the inherited object. As more than one
  4408.  * object can be inherited, the call of function by index number has to
  4409.  * be adjusted. The function number 0 in a superclass object must not remain
  4410.  * number 0 when it is inherited from a subclass object. The same problem
  4411.  * exists for variables. The global variables function_index_offset and
  4412.  * variable_index_offset keep track of how much to adjust the index when
  4413.  * executing code in the superclass objects.
  4414.  *
  4415.  * There is a special case when called from the heart beat, as
  4416.  * current_prog will be 0. When it is 0, set current_prog
  4417.  * to the 'ob->prog' sent as argument.
  4418.  *
  4419.  * Arguments are always removed from the stack.
  4420.  * If the function is not found, return 0 and nothing on the stack.
  4421.  * Otherwise, return 1, and a pushed return value on the stack.
  4422.  *
  4423.  * Note that the object 'ob' can be destructed. This must be handled by
  4424.  * the caller of apply().
  4425.  *
  4426.  * If the function failed to be called, then arguments must be deallocated
  4427.  * manually !
  4428.  */
  4429.  
  4430. char debug_apply_fun[30]; /* For debugging */
  4431.  
  4432. static int apply_low(fun, ob, num_arg)
  4433.     char *fun;
  4434.     struct object *ob;
  4435.     int num_arg;
  4436. {
  4437.     static int cache_id[0x40] = {
  4438.       0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
  4439.       0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 };
  4440.     static char *cache_name[0x40];
  4441.     static struct function *cache_pr[0x40];
  4442.     static struct function *cache_pr_inherited[0x40];
  4443.     static struct program *cache_progp[0x40];
  4444.     static int cache_function_index_offset[0x40];
  4445.     static int cache_variable_index_offset[0x40];
  4446.  
  4447.     struct function *pr;
  4448.     struct program *progp;
  4449.     extern int num_error;
  4450.     struct control_stack *save_csp;
  4451.     int ix;
  4452.  
  4453.     ob->time_of_ref = current_time;    /* Used by the swapper */
  4454.  
  4455. #ifdef COMPAT_MODE
  4456.     if (ob->next_reset < current_time) 
  4457.     {
  4458.        struct object *s = command_giver;
  4459.        int save = eval_cost;
  4460.    /* if it's past due, reset immediately, else just mark it to be reset */
  4461.        eval_cost = 0;
  4462.        reset_object(ob, 1);
  4463.        eval_cost = save;
  4464.        command_giver = s;
  4465.     }
  4466.     else 
  4467. #endif
  4468.        ob->flags &= ~O_RESET_STATE;
  4469.  
  4470. #ifdef DEBUG
  4471.     strncpy(debug_apply_fun, fun, sizeof debug_apply_fun);
  4472.     debug_apply_fun[sizeof debug_apply_fun - 1] = '\0';
  4473. #endif
  4474.     if (num_error > 0)
  4475.     goto failure;
  4476.     if (fun[0] == ':')
  4477.     error("Illegal function call\n");
  4478.     /*
  4479.      * If there is a chain of objects shadowing, start with the first
  4480.      * of these.
  4481.      */
  4482.     while (ob->shadowed && ob->shadowed != current_object)
  4483.     ob = ob->shadowed;
  4484. retry_for_shadow:
  4485.     if (ob->flags & O_SWAPPED)
  4486.     load_ob_from_swap(ob);
  4487.     progp = ob->prog;
  4488. #ifdef DEBUG
  4489.     if (ob->flags & O_DESTRUCTED)
  4490.     fatal("apply() on destructed object\n");
  4491. #endif
  4492.     ix = ( progp->id_number ^ (int)fun ^ ( (int)fun >> 6 ) ) & 0x3f;
  4493.     if (cache_id[ix] == progp->id_number && !strcmp(cache_name[ix], fun) ) {
  4494.       /* We have found a matching entry in the cache. The pointer to
  4495.      the function name has to match, not only the contents.
  4496.      This is because hashing the string in order to get a cache index
  4497.      would be much more costly than hashing it's pointer.
  4498.      If cache access would be costly, the cache would be useless.
  4499.        */
  4500.       if (cache_progp[ix]) {
  4501.         /* the cache will tell us in wich program the function is, and
  4502.      * where
  4503.      */
  4504.     push_control_stack(cache_pr[ix]);
  4505.     csp->num_local_variables = num_arg;
  4506.     current_prog = cache_progp[ix];
  4507.     pr = cache_pr_inherited[ix];
  4508.         function_index_offset = cache_function_index_offset[ix];
  4509.         variable_index_offset = cache_variable_index_offset[ix];
  4510.         /* Remove excessive arguments */
  4511.         while(csp->num_local_variables > pr->num_arg) {
  4512.             pop_stack();
  4513.             csp->num_local_variables--;
  4514.         }
  4515.         /* Correct number of arguments and local variables */
  4516.         while(csp->num_local_variables < pr->num_arg + pr->num_local) {
  4517.             push_number(0);
  4518.             csp->num_local_variables++;
  4519.         }
  4520.         tracedepth++;
  4521.         if (TRACEP(TRACE_CALL)) {
  4522.         do_trace_call(pr);
  4523.         }
  4524.         fp = sp - csp->num_local_variables + 1;
  4525.         break_sp = (short*)(sp+1);
  4526. #ifdef COMPAT_MODE 
  4527.     /* Now, previous_object() is always set, even by
  4528.      * call_other(this_object()). It should not break any compatibility.
  4529.      */
  4530.         if (current_object != ob)
  4531. #endif
  4532.             previous_ob = current_object;
  4533.         frame_ob = current_object;
  4534.         current_object = ob;
  4535.         save_csp = csp;
  4536.         eval_instruction(current_prog->program + pr->offset);
  4537. #ifdef DEBUG
  4538.         if (save_csp-1 != csp)
  4539.             fatal("Bad csp after execution in apply_low\n");
  4540. #endif
  4541.         /*
  4542.          * Arguments and local variables are now removed. One
  4543.          * resulting value is always returned on the stack.
  4544.          */
  4545.         return 1;
  4546.       } /* when we come here, the cache has told us that the function isn't
  4547.      * defined in the object
  4548.      */
  4549.     } else {
  4550.     /* we have to search the function */
  4551.     if (!cache_progp[ix] && cache_id[ix]) {
  4552.         /* The old cache entry was for an undefined function, so the
  4553.            name had to be malloced */
  4554.         free(cache_name[ix]);
  4555.     }
  4556.     cache_id[ix] = progp->id_number;
  4557.         for(pr=progp->functions; pr < progp->functions + progp->num_functions;
  4558.             pr++)
  4559.         {
  4560.             eval_cost++;
  4561.             if (pr->name == 0 ||
  4562.                 pr->name[0] != fun[0] ||
  4563.                 strcmp(pr->name, fun) != 0 ||
  4564.                 (pr->type & TYPE_MOD_PRIVATE))
  4565.             {
  4566.                 continue;
  4567.             }
  4568.             if (pr->flags & NAME_UNDEFINED)
  4569.                 continue;
  4570.             /* Static functions may not be called from outside. */
  4571.             if ((pr->type & TYPE_MOD_STATIC) && current_object != ob)
  4572.                 continue;
  4573.         /* The searched function is found */
  4574.         cache_pr[ix] = pr;
  4575.         cache_name[ix] = pr->name;
  4576.         push_control_stack(pr);
  4577.         csp->num_local_variables = num_arg;
  4578.         current_prog = progp;
  4579.         pr = setup_new_frame(pr);
  4580.         cache_pr_inherited[ix] = pr;
  4581.         cache_progp[ix] = current_prog;
  4582.         cache_variable_index_offset[ix] = variable_index_offset;
  4583.         cache_function_index_offset[ix] = function_index_offset;
  4584.             if (current_object != ob)
  4585.                 previous_ob = current_object;
  4586.             frame_ob = current_object;
  4587.             current_object = ob;
  4588.             save_csp = csp;
  4589.             eval_instruction(current_prog->program + pr->offset);
  4590. #ifdef DEBUG
  4591.             if (save_csp-1 != csp)
  4592.                 fatal("Bad csp after execution in apply_low\n");
  4593. #endif
  4594.             /*
  4595.              * Arguments and local variables are now removed. One
  4596.              * resulting value is always returned on the stack.
  4597.              */
  4598.             return 1;
  4599.     }
  4600.     /* We have to mark a function not to be in the object */
  4601.     cache_name[ix] = string_copy(fun);
  4602.     cache_progp[ix] = (struct program *)0;
  4603.     }
  4604.     if (ob->shadowing) {
  4605.     /*
  4606.      * This is an object shadowing another. The function was not found,
  4607.      * but can maybe be found in the object we are shadowing.
  4608.      */
  4609.     ob = ob->shadowing;
  4610.     goto retry_for_shadow;
  4611.     }
  4612. failure:
  4613.     /* Failure. Deallocate stack. */
  4614.     pop_n_elems(num_arg);
  4615.     return 0;
  4616. }
  4617.  
  4618. /*
  4619.  * Arguments are supposed to be
  4620.  * pushed (using push_string() etc) before the call. A pointer to a
  4621.  * 'struct svalue' will be returned. It will be a null pointer if the called
  4622.  * function was not found. Otherwise, it will be a pointer to a static
  4623.  * area in apply(), which will be overwritten by the next call to apply.
  4624.  * Reference counts will be updated for this value, to ensure that no pointers
  4625.  * are deallocated.
  4626.  */
  4627.  
  4628. static struct svalue *sapply(fun, ob, num_arg)
  4629.     char *fun;
  4630.     struct object *ob;
  4631.     int num_arg;
  4632. {
  4633. #ifdef DEBUG
  4634.     struct svalue *expected_sp;
  4635. #endif
  4636.     static struct svalue ret_value = { T_NUMBER };
  4637.  
  4638.     if (TRACEP(TRACE_APPLY)) {
  4639.     do_trace("Apply", "", "\n");
  4640.     }
  4641. #ifdef DEBUG
  4642.     expected_sp = sp - num_arg;
  4643. #endif
  4644.     if (apply_low(fun, ob, num_arg) == 0)
  4645.     return 0;
  4646.     assign_svalue(&ret_value, sp);
  4647.     pop_stack();
  4648. #ifdef DEBUG
  4649.     if (expected_sp != sp)
  4650.     fatal("Corrupt stack pointer.\n");
  4651. #endif
  4652.     return &ret_value;
  4653. }
  4654.  
  4655. struct svalue *apply(fun, ob, num_arg)
  4656.     char *fun;
  4657.     struct object *ob;
  4658.     int num_arg;
  4659. {
  4660.     tracedepth = 0;
  4661.     return sapply(fun, ob, num_arg);
  4662. }
  4663.  
  4664. /*
  4665.  * This function is similar to apply(), except that it will not
  4666.  * call the function, only return object name if the function exists,
  4667.  * or 0 otherwise.
  4668.  */
  4669. char *function_exists(fun, ob)
  4670.     char *fun;
  4671.     struct object *ob;
  4672. {
  4673.     struct function *pr;
  4674.  
  4675. #ifdef DEBUG
  4676.     if (ob->flags & O_DESTRUCTED)
  4677.     fatal("function_exists() on destructed object\n");
  4678. #endif
  4679.     if (ob->flags & O_SWAPPED)
  4680.     load_ob_from_swap(ob);
  4681.     pr = ob->prog->functions;
  4682.     for(; pr < ob->prog->functions + ob->prog->num_functions; pr++) {
  4683.     struct program *progp;
  4684.  
  4685.     if (pr->name[0] != fun[0] || strcmp(pr->name, fun) != 0)
  4686.         continue;
  4687.     /* Static functions may not be called from outside. */
  4688.     if ((pr->type & TYPE_MOD_STATIC) && current_object != ob)
  4689.         continue;
  4690.     if (pr->flags & NAME_UNDEFINED)
  4691.         return 0;
  4692.     for (progp = ob->prog; pr->flags & NAME_INHERITED;) {
  4693.         progp = progp->inherit[pr->offset].prog;
  4694.         pr = &progp->functions[pr->function_index_offset];
  4695.     }
  4696.     return progp->name;
  4697.     }
  4698.     return 0;
  4699. }
  4700.  
  4701. /*
  4702.  * Call a specific function address in an object. This is done with no
  4703.  * frame set up. It is expected that there are no arguments. Returned
  4704.  * values are removed.
  4705.  */
  4706.  
  4707. void call_function(progp, pr)
  4708.     struct program *progp;
  4709.     struct function *pr;
  4710. {
  4711.     if (pr->flags & NAME_UNDEFINED)
  4712.     return;
  4713.     push_control_stack(pr);
  4714. #ifdef DEBUG
  4715.     if (csp != control_stack)
  4716.     fatal("call_function with bad csp\n");
  4717. #endif
  4718.     csp->num_local_variables = 0;
  4719.     current_prog = progp;
  4720.     pr = setup_new_frame(pr);
  4721.     previous_ob = current_object;
  4722.     tracedepth = 0;
  4723.     eval_instruction(current_prog->program + pr->offset);
  4724.     pop_stack();    /* Throw away the returned result */
  4725. }
  4726.  
  4727. /*
  4728.  * This can be done much more efficiently, but the fix has
  4729.  * low priority.
  4730.  */
  4731. static int get_line_number(p, progp)
  4732.     char *p;
  4733.     struct program *progp;
  4734. {
  4735.     int offset;
  4736.     int i;
  4737.     if (progp == 0)
  4738.     return 0;
  4739.     offset = p - progp->program;
  4740. #ifdef DEBUG
  4741.     if (offset > progp->program_size)
  4742.     fatal("Illegal offset %d in object %s\n", offset, progp->name);
  4743. #endif
  4744.     for (i=0; offset > progp->line_numbers[i]; i++)
  4745.     ;
  4746.     return i+1;
  4747. }
  4748.     
  4749. /*
  4750.  * Write out a trace. If there is an heart_beat(), then return the
  4751.  * object that had that heart beat.
  4752.  */
  4753. #if defined(DEBUG) && defined(TRACE_CODE)
  4754. char *dump_trace(how)
  4755. int how;
  4756. #else
  4757. char *dump_trace()
  4758. #endif
  4759. {
  4760.     struct control_stack *p;
  4761.     char *ret = 0;
  4762. #ifdef DEBUG
  4763.     int last_instructions PROT((void));
  4764. #endif
  4765.  
  4766.     if (current_prog == 0)
  4767.     return 0;
  4768.     if (csp < &control_stack[0]) {
  4769.     (void)printf("No trace.\n");
  4770.     debug_message("No trace.\n");
  4771.     return 0;
  4772.     }
  4773. #ifdef DEBUG
  4774. #ifdef TRACE_CODE
  4775.     if (how)
  4776.     (void)last_instructions();
  4777. #endif
  4778. #endif
  4779.     for (p = &control_stack[0]; p < csp; p++) {
  4780.     (void)printf("\"%s\" in \"%s\" (\"%s\") line %d\n",
  4781.              p[0].funp ? p[0].funp->name : "CATCH",
  4782.              p[1].prog->name, p[1].ob->name,
  4783.              get_line_number(p[1].pc, p[1].prog));
  4784.     debug_message("\"%s\" in \"%s\" (\"%s\") line %d\n",
  4785.              p[0].funp ? p[0].funp->name : "CATCH",
  4786.              p[1].prog->name, p[1].ob->name,
  4787.              get_line_number(p[1].pc, p[1].prog));
  4788.     if (p->funp && strcmp(p->funp->name, "heart_beat") == 0)
  4789.         ret = p->ob?p->ob->name:0;
  4790.     }
  4791.     (void)printf("\"%s\" in \"%s\" (\"%s\") line %d\n",
  4792.          p[0].funp ? p[0].funp->name : "CATCH",
  4793.          current_prog->name, current_object->name,
  4794.          get_line_number(pc, current_prog));
  4795.     debug_message("\"%s\" in \"%s\" (\"%s\") line %d\n",
  4796.          p[0].funp ? p[0].funp->name : "CATCH",
  4797.          current_prog->name, current_object->name,
  4798.          get_line_number(pc, current_prog));
  4799.     return ret;
  4800. }
  4801.  
  4802. int get_line_number_if_any() {
  4803.     if (current_prog)
  4804.     return get_line_number(pc, current_prog);
  4805.     return 0;
  4806. }
  4807.  
  4808. static char *find_percent(str)
  4809.     char *str;
  4810. {
  4811.     while(1) {
  4812.     str = strchr(str, '%');
  4813.     if (str == 0)
  4814.         return 0;
  4815.     if (str[1] != '%')
  4816.         return str;
  4817.     str++;
  4818.     }
  4819. }
  4820.  
  4821. static int inter_sscanf(num_arg)
  4822.     int num_arg;
  4823. {
  4824.     char *fmt;        /* Format description */
  4825.     char *in_string;    /* The string to be parsed. */
  4826.     int number_of_matches;
  4827.     char *cp;
  4828.     struct svalue *arg = sp - num_arg + 1;
  4829.  
  4830.     /*
  4831.      * First get the string to be parsed.
  4832.      */
  4833.     if (arg[0].type != T_STRING && arg[0].type != T_OBJECT)
  4834.     bad_arg(1, F_SSCANF);
  4835.     if (arg[0].type == T_STRING)
  4836.        in_string = arg[0].u.string;
  4837.     else in_string = arg[0].u.ob->name;
  4838.     if (in_string == 0)
  4839.     return 0;
  4840.     /*
  4841.      * Now get the format description.
  4842.      */
  4843.     if (arg[1].type != T_STRING)
  4844.     bad_arg(2, F_SSCANF);
  4845.     fmt = arg[1].u.string;
  4846.     /*
  4847.      * First, skip and match leading text.
  4848.      */
  4849.     for (cp=find_percent(fmt); fmt != cp; fmt++, in_string++) {
  4850.     if (in_string[0] == '\0' || fmt[0] != in_string[0])
  4851.         return 0;
  4852.     }
  4853.     /*
  4854.      * Loop for every % or substring in the format. Update num_arg and the
  4855.      * arg pointer continuosly. Assigning is done manually, for speed.
  4856.      */
  4857.     num_arg -= 2;
  4858.     arg += 2;
  4859.     for (number_of_matches=0; num_arg > 0;
  4860.      number_of_matches++, num_arg--, arg++) {
  4861.     int i, type;
  4862.  
  4863.     if (fmt[0] == '\0') {
  4864.         /*
  4865.          * We have reached end of the format string.
  4866.          * If there are any chars left in the in_string,
  4867.          * then we put them in the last variable (if any).
  4868.          */
  4869.         if (in_string[0]) {
  4870.         free_svalue(arg->u.lvalue, "F_SSCANF");
  4871.         arg->u.lvalue->type = T_STRING;
  4872.         arg->u.lvalue->u.string = make_shared_string(in_string);
  4873.         arg->u.lvalue->string_type = STRING_SHARED;/**MALLOC**/
  4874.         number_of_matches++;
  4875.         }
  4876.         break;
  4877.     }
  4878. #ifdef DEBUG
  4879.     if (fmt[0] != '%')
  4880.         fatal("Should be a %% now !\n");
  4881. #endif
  4882.     type = T_STRING;
  4883.     if (fmt[1] == 'd')
  4884.         type = T_NUMBER;
  4885.     else if (fmt[1] != 's')
  4886.         error("Bad type : '%%%c' in sscanf fmt string.", fmt[1]);
  4887.     fmt += 2;
  4888.     /*
  4889.      * Parsing a number is the easy case. Just use strtol() to
  4890.      * find the end of the number.
  4891.      */
  4892.     if (type == T_NUMBER) {
  4893.         char *tmp = in_string;
  4894.         int tmp_num;
  4895.  
  4896.         tmp_num = (int) strtol(in_string, &in_string, 10);
  4897.         if(tmp == in_string) {
  4898.         /* No match */
  4899.         break;
  4900.         }
  4901.         free_svalue(arg->u.lvalue, "F_SSCANF");
  4902.         arg->u.lvalue->type = T_NUMBER;
  4903.         arg->u.lvalue->u.number = tmp_num;
  4904.         while(fmt[0] && fmt[0] == in_string[0])
  4905.         fmt++, in_string++;
  4906.         if (fmt[0] != '%') {
  4907.         number_of_matches++;
  4908.         break;
  4909.         }
  4910.         continue;
  4911.     }
  4912.     /*
  4913.      * Now we have the string case.
  4914.      */
  4915.     cp = find_percent(fmt);
  4916.     if (cp == fmt)
  4917.         error("Illegal to have 2 adjacent %'s in fmt string in sscanf.");
  4918.     if (cp == 0)
  4919.         cp = fmt + strlen(fmt);
  4920.     /*
  4921.      * First case: There was no extra characters to match.
  4922.      * Then this is the last match.
  4923.      */
  4924.     if (cp == fmt) {
  4925.         free_svalue(arg->u.lvalue, "F_SSCANF");
  4926.         arg->u.lvalue->type = T_STRING;
  4927.         arg->u.lvalue->u.string = make_shared_string(in_string);
  4928.         arg->u.lvalue->string_type = STRING_SHARED; /**MALLOC**/
  4929.         number_of_matches++;
  4930.         break;
  4931.     }
  4932.     for (i=0; in_string[i]; i++) {
  4933.         if (strncmp(in_string+i, fmt, cp - fmt) == 0) {
  4934.         char *match;
  4935.         /*
  4936.          * Found a match !
  4937.          */
  4938.         match = xalloc(i+1);
  4939.         (void)strncpy(match, in_string, i);
  4940.         in_string += i + cp - fmt;
  4941.         match[i] = '\0';
  4942.         free_svalue(arg->u.lvalue, "F_SSCANF");
  4943.         arg->u.lvalue->type = T_STRING;
  4944.         arg->u.lvalue->u.string = make_shared_string(match);
  4945.         arg->u.lvalue->string_type = STRING_SHARED;
  4946.                 free(match); /**MALLOC**/
  4947.         fmt = cp;    /* Advance fmt to next % */
  4948.         break;
  4949.         }
  4950.     }
  4951.     if (fmt == cp)    /* If match, then do continue. */
  4952.         continue;
  4953.     /*
  4954.      * No match was found. Then we stop here, and return
  4955.      * the result so far !
  4956.      */
  4957.     break;
  4958.     }
  4959.     return number_of_matches;
  4960. }
  4961.  
  4962. /* test stuff ... -- LA */
  4963. #ifdef OPCPROF
  4964. void opcdump()
  4965. {
  4966.     int i;
  4967.  
  4968.     for(i = 0; i < MAXOPC; i++)
  4969.     if (opcount[i]) printf("%d: %d\n", i, opcount[i]);
  4970. }
  4971. #endif
  4972.  
  4973. /*
  4974.  * Reset the virtual stack machine.
  4975.  */
  4976. void reset_machine(first)
  4977.     int first;
  4978. {
  4979.     csp = control_stack - 1;
  4980.     if (first)
  4981.     sp = start_of_stack - 1;
  4982.     else
  4983.     pop_n_elems(sp - start_of_stack + 1);
  4984. }
  4985.  
  4986. #ifdef TRACE_CODE
  4987.  
  4988. static char *get_arg(a, b)
  4989.     int a, b;
  4990. {
  4991.     static char buff[10];
  4992.     char *from, *to;
  4993.  
  4994.     from = previous_pc[a]; to = previous_pc[b];
  4995.     if (to - from < 2)
  4996.     return "";
  4997.     if (to - from == 2) {
  4998.     sprintf(buff, "%d", from[1]);
  4999.     return buff;
  5000.     }
  5001.     if (to - from == 3) {
  5002.     short arg;
  5003.     ((char *)&arg)[0] = from[1];
  5004.     ((char *)&arg)[1] = from[2];
  5005.     sprintf(buff, "%d", arg);
  5006.     return buff;
  5007.     }
  5008.     if (to - from == 5) {
  5009.     int arg;
  5010.     ((char *)&arg)[0] = from[1];
  5011.     ((char *)&arg)[1] = from[2];
  5012.     ((char *)&arg)[2] = from[3];
  5013.     ((char *)&arg)[3] = from[4];
  5014.     sprintf(buff, "%d", arg);
  5015.     return buff;
  5016.     }
  5017.     return "";
  5018. }
  5019.  
  5020. int last_instructions() {
  5021.     int i;
  5022.     i = last;
  5023.     do {
  5024.     if (previous_instruction[i] != 0)
  5025.         printf("%6x: %3d %8s %-25s (%d)\n", previous_pc[i],
  5026.            previous_instruction[i],
  5027.            get_arg(i, (i+1) %
  5028.                (sizeof previous_instruction / sizeof (int))),
  5029.            get_f_name(previous_instruction[i]),
  5030.            stack_size[i] + 1);
  5031.     i = (i + 1) % (sizeof previous_instruction / sizeof (int));
  5032.     } while (i != last);
  5033.     return last;
  5034. }
  5035.  
  5036. #endif /* TRACE_CODE */
  5037.  
  5038.  
  5039. #ifdef DEBUG
  5040.  
  5041. static void count_inherits(progp, search_prog)
  5042.     struct program *progp, *search_prog;
  5043. {
  5044.     int i;
  5045.     if (!progp || progp->extra_ref != 1) return;
  5046.     for (i=0; i< progp->num_inherited; i++) {
  5047.     progp->inherit[i].prog->extra_ref++;
  5048.     if (progp->inherit[i].prog == search_prog)
  5049.         printf("Found prog, inherited by %s\n", progp->name);
  5050.         count_inherits(progp->inherit[i].prog, search_prog);
  5051.     }
  5052. }
  5053.  
  5054. static void count_ref_in_vector(svp, num)
  5055.     struct svalue *svp;
  5056.     int num;
  5057. {
  5058.     struct svalue *p;
  5059.  
  5060.     for (p = svp; p < svp+num; p++) {
  5061.     switch(p->type) {
  5062.     case T_OBJECT:
  5063.         p->u.ob->extra_ref++;
  5064.         continue;
  5065.     case T_POINTER:
  5066.         count_ref_in_vector(&p->u.vec->item[0], p->u.vec->size);
  5067.         p->u.vec->extra_ref++;
  5068.         continue;
  5069.     }
  5070.     }
  5071. }
  5072.  
  5073. void clear_vector_refs(svp, num)
  5074.     struct svalue *svp;
  5075.     int num;
  5076. {
  5077.     struct svalue *p;
  5078.  
  5079.     for (p = svp; p < svp+num; p++) {
  5080.     switch(p->type) {
  5081.     case T_POINTER:
  5082.         clear_vector_refs(&p->u.vec->item[0], p->u.vec->size);
  5083.         p->u.vec->extra_ref=0;
  5084.         continue;
  5085.     }
  5086.     }
  5087. }
  5088.  
  5089. /*
  5090.  * Loop through every object and variable in the game and check
  5091.  * all reference counts. This will surely take some time.
  5092.  */
  5093. void check_a_lot_ref_counts(search_prog)
  5094.     struct program *search_prog;
  5095. {
  5096.     extern struct object *master_ob;
  5097.     struct object *ob;
  5098.     struct svalue *p;
  5099.  
  5100.     /*
  5101.      * Pass 1: clear the ref counts.
  5102.      */
  5103.     for (ob=obj_list; ob; ob = ob->next_all) {
  5104.     ob->extra_ref = 0;
  5105.     ob->prog->extra_ref = 0;
  5106.     clear_vector_refs(ob->variables, ob->prog->num_variables);
  5107.     }
  5108.     for (ob=obj_list_destruct; ob; ob = ob->next_all) {
  5109.         ob->extra_ref = 0;
  5110.         ob->prog->extra_ref = 0;
  5111.     clear_vector_refs(ob->variables, ob->prog->num_variables);
  5112.     }
  5113.  
  5114.     clear_vector_refs(start_of_stack, sp - start_of_stack + 1);
  5115.  
  5116.     /*
  5117.      * Pass 2: Compute the ref counts.
  5118.      */
  5119.  
  5120.     /*
  5121.      * List of all objects.
  5122.      */
  5123.     for (ob=obj_list; ob; ob = ob->next_all) {
  5124.     ob->extra_ref++;
  5125.     count_ref_in_vector(ob->variables, ob->prog->num_variables);
  5126.     ob->prog->extra_ref++;
  5127.     if (ob->prog == search_prog)
  5128.         printf("Found program for object %s\n", ob->name);
  5129.     /* Clones will not add to the ref count of inherited progs */
  5130.     if (ob->prog->extra_ref == 1)
  5131.         count_inherits(ob->prog, search_prog);
  5132.     }
  5133.     for (ob=obj_list_destruct; ob; ob = ob->next_all) 
  5134.     {
  5135.     ob->extra_ref++;
  5136.     count_ref_in_vector(ob->variables, ob->prog->num_variables);
  5137.     ob->prog->extra_ref++;
  5138.     if (ob->prog == search_prog)
  5139.         printf("Found program for destructed object %s\n", ob->name);
  5140.     /* Clones will not add to the ref count of inherited progs */
  5141.     if (ob->prog->extra_ref == 1)
  5142.         count_inherits(ob->prog, search_prog);
  5143.     }
  5144.  
  5145.     /*
  5146.      * The current stack.
  5147.      */
  5148.     count_ref_in_vector(start_of_stack, sp - start_of_stack + 1);
  5149.     update_ref_counts_for_players();
  5150.     count_ref_from_call_outs();
  5151.     if (master_ob) master_ob->extra_ref++; /* marion */
  5152.  
  5153.     if (search_prog)
  5154.     return;
  5155.  
  5156.     /*
  5157.      * Pass 3: Check the ref counts.
  5158.      */
  5159.     for (ob=obj_list; ob; ob = ob->next_all) {
  5160.     if (ob->ref != ob->extra_ref)
  5161.          fatal("Bad ref count in object %s, %d - %d\n", ob->name,
  5162.           ob->ref, ob->extra_ref);
  5163.     if (ob->prog->ref != ob->prog->extra_ref) {
  5164.         check_a_lot_ref_counts(ob->prog);
  5165.         fatal("Bad ref count in prog %s, %d - %d\n", ob->prog->name,
  5166.           ob->prog->ref, ob->prog->extra_ref);
  5167.     }
  5168.     }
  5169. }
  5170.  
  5171. #endif /* DEBUG */
  5172.  
  5173. /*
  5174.  * Added 3/31/91 by Raistlin.
  5175.  * added attributes to objects.
  5176.  */
  5177.  
  5178. static Attribute *find_attribute(attr, obj)
  5179. char *attr;
  5180. struct object *obj;
  5181. {
  5182.    int i;
  5183.  
  5184.    for (i=0; i<obj->num_attributes; ++i)
  5185.       if (strcmp(attr, obj->attributes[i].attribute) == 0)
  5186.          return &(obj->attributes[i]);
  5187.    return NULL;
  5188. }
  5189.  
  5190. static void add_attribute(attr, obj, val, prot)
  5191. char *attr;
  5192. struct object *obj;
  5193. int val;
  5194. int prot;
  5195. {
  5196.    int size;
  5197.    Attribute *a;   
  5198.  
  5199.    
  5200.    if (a = find_attribute(attr, obj)) 
  5201.    { 
  5202.       a->value = val;
  5203.       if (prot) 
  5204.          a->protected = prot;
  5205.       return;
  5206.    }
  5207.    size = ++(obj->num_attributes);
  5208.    if (obj->attributes)
  5209.       obj->attributes = (Attribute *)
  5210.             realloc((char *)obj->attributes, size*sizeof(Attribute));
  5211.    else 
  5212.       obj->attributes = (Attribute *) xalloc(sizeof(Attribute));
  5213.  
  5214.    obj->attributes[size-1].attribute = make_shared_string(attr);
  5215.    obj->attributes[size-1].value = val;
  5216.    obj->attributes[size-1].protected = prot;
  5217. }
  5218.  
  5219. static int query_attribute(attr, obj)
  5220. char *attr;
  5221. struct object *obj;
  5222. {
  5223.    return find_attribute(attr, obj) != 0;
  5224. }
  5225.  
  5226. static int get_attribute(str, obj)
  5227. char *str;
  5228. struct object *obj;
  5229. {
  5230.    Attribute *attrib;
  5231.    if (attrib = find_attribute(str, obj))
  5232.        return attrib->value;
  5233.    else
  5234.        return -1;
  5235. }
  5236.  
  5237. static struct vector *get_attr_vector(obj)
  5238. struct object *obj;
  5239. {
  5240.    struct vector *vec;
  5241.    int i;
  5242.  
  5243.    vec = allocate_array(obj->num_attributes*2);
  5244.    for (i=0; i<obj->num_attributes; ++i)
  5245.    {
  5246.       vec->item[i*2].type = T_STRING;
  5247.       vec->item[i*2].string_type = STRING_SHARED;
  5248.       vec->item[i*2].u.string=make_shared_string(obj->attributes[i].attribute);
  5249.       vec->item[i*2+1].type = T_NUMBER;
  5250.       vec->item[i*2+1].u.number = obj->attributes[i].value;
  5251.    }
  5252.    return vec;
  5253. }
  5254.  
  5255. static void delete_attribute(attr, obj)
  5256. char *attr;
  5257. struct object *obj;
  5258. {
  5259.    Attribute *del;
  5260.    
  5261.    if (!(del = find_attribute(attr, obj))) return;
  5262.    if (del->protected)
  5263.    {
  5264.       error("Error, cannot delete protected attribute %s.\n", del->attribute);
  5265.       return;
  5266.    }
  5267.  
  5268.    if (obj->num_attributes == 1)
  5269.    {
  5270.       free_string(obj->attributes[0].attribute);
  5271.       free((char *)obj->attributes);
  5272.       obj->attributes = NULL;
  5273.       obj->num_attributes = 0;
  5274.       return;
  5275.    }
  5276.    free_string(del->attribute);
  5277.    memcpy(del, del+1, (obj->attributes+obj->num_attributes-del-1)*
  5278.           sizeof(Attribute));
  5279.  
  5280.    obj->num_attributes--;
  5281.    if (obj->num_attributes)
  5282.       obj->attributes = (Attribute *) realloc((char *)obj->attributes, 
  5283.             obj->num_attributes);
  5284.    else 
  5285.    {
  5286.       free((char *)obj->attributes); 
  5287.       obj->attributes = NULL;
  5288.    }
  5289. } 
  5290.  
  5291.  
  5292. static int search_string(str, what, where)
  5293. char *str;
  5294. int what, where;
  5295. {
  5296.    char *i;
  5297.  
  5298.    i = (char *) strchr(str+where, what);
  5299.    if (i) return i-str;
  5300.    else return -1;
  5301. }
  5302.  
  5303. int search_array(a, target, ind)
  5304. struct svalue *a;
  5305. struct svalue *target;
  5306. int ind;
  5307. {
  5308.     int ret;
  5309.     struct svalue orig_targ;
  5310.     int i;
  5311.  
  5312.     if (a->type == T_STRING)
  5313.     {
  5314.        if (target->type != T_NUMBER)
  5315.           error("Incompatible argument 2 to searcha on a string.\n");
  5316.        return search_string(a->u.string, target->u.number, ind);
  5317.     }   
  5318.     if(a->u.vec->size==0 && ind==0) return -1;
  5319.     if (ind+1 > a->u.vec->size || ind<0 || ind>MAX_ARRAY_SIZE)
  5320.         error("Illegal ind to searcha().\n");
  5321.     
  5322.     orig_targ= *target;
  5323.     if (target->type==T_OBJECT && (target->u.ob->flags&O_DESTRUCTED)) {
  5324.     target->type=T_NUMBER;
  5325.     target->u.number=0;
  5326.     }
  5327.     ret = -1;
  5328.     for (i=ind; i < a->u.vec->size; i++) {
  5329.  
  5330.     if (a->u.vec->item[i].type!=target->type &&
  5331.         !(a->u.vec->item[i].type==T_OBJECT && 
  5332.                   (a->u.vec->item[i].u.ob->flags&O_DESTRUCTED) && 
  5333.             target->type==T_NUMBER))
  5334.         continue;
  5335.     switch (target->type) {
  5336.         case T_OBJECT:
  5337.         if (a->u.vec->item[i].u.ob==target->u.ob &&
  5338.             !(a->u.vec->item[i].u.ob->flags&O_DESTRUCTED))
  5339.             ret = i;
  5340.         break;
  5341.         case T_STRING:
  5342.         if (strcmp(a->u.vec->item[i].u.string,target->u.string)==0)
  5343.             ret = i;
  5344.         break;
  5345.         case T_POINTER:
  5346.         if (a->u.vec->item[i].u.vec==target->u.vec)
  5347.             ret = i;
  5348.         break;
  5349.         case T_NUMBER:
  5350.         if (a->u.vec->item[i].u.number==target->u.number)
  5351.             ret = i;
  5352.         else
  5353.                     if (a->u.vec->item[i].type==T_OBJECT &&
  5354.             (a->u.vec->item[i].u.ob->flags&O_DESTRUCTED) &&
  5355.                 target->u.number==0)
  5356.             ret = i;
  5357.         break;
  5358.         default:
  5359.         break;
  5360.     }
  5361.     if (ret != -1)
  5362.         break;
  5363.     }
  5364.     *target=orig_targ;
  5365.     return ret;
  5366. }
  5367.  
  5368. struct vector *reallocate_array(a, n)
  5369.     struct vector *a;
  5370.     int n;
  5371. {
  5372.     int i,j;
  5373.     struct vector *p,*ap;
  5374.  
  5375.     if (n < 0 || n > MAX_ARRAY_SIZE) error("Illegal array size.\n");
  5376.         p = allocate_array(n);
  5377. /*
  5378.     p = ALLOC_VECTOR(n);
  5379.     p->ref = 1;
  5380.     p->size = n;
  5381.     p->user = current_object->user;
  5382.     if (p->user) p->user->size_array += n;
  5383. */
  5384.     j = ((a->size) < n) ? (a->size) : n;
  5385.     ap = a;
  5386.     for (i=0; i<n; i++) {
  5387.          if (i<j) {
  5388.              p->item[i].type=ap->item[i].type;
  5389.  
  5390.              switch (p->item[i].type) {
  5391.             case T_STRING:
  5392.                 p->item[i].u.string =
  5393.                     make_shared_string(ap->item[i].u.string);
  5394.                                 p->item[i].string_type = STRING_SHARED;
  5395.                  break;
  5396.              case T_OBJECT:
  5397.                 if (ap->item[i].u.ob->flags&O_DESTRUCTED) {
  5398.                     p->item[i].type=T_NUMBER;
  5399.                     p->item[i].u.number=0;
  5400.                 } else {
  5401.                     p->item[i].u.ob=ap->item[i].u.ob; 
  5402.                      add_ref(p->item[i].u.ob,
  5403.                         "reallocate_array");
  5404.                 }
  5405.                  break;
  5406.              case T_POINTER:
  5407.                 p->item[i].u.vec=ap->item[i].u.vec;
  5408.                  p->item[i].u.vec->ref++;
  5409.                  break;
  5410.              case T_NUMBER:
  5411.                 p->item[i].u.number=ap->item[i].u.number;
  5412.                 break;
  5413.             default:
  5414.                 p->item[i].type=T_NUMBER;
  5415.                 p->item[i].u.number=0;
  5416.                 break;
  5417.              }
  5418.          } else {
  5419.              p->item[i].type=T_NUMBER;
  5420.              p->item[i].u.number=0;
  5421.         }
  5422.     }
  5423.         return p;
  5424. }
  5425.  
  5426. struct object *caller()
  5427. {
  5428.    if (frame_ob == 0 || (frame_ob->flags&O_DESTRUCTED))
  5429.       return 0;
  5430.    return frame_ob;
  5431. }
  5432.  
  5433. int rename_file(src, dst)
  5434.     char *src, *dst;
  5435. {
  5436.     extern int sys_nerr, errno;
  5437.     extern char *sys_errlist[];
  5438.     char tmp1[500], tmp2[500];
  5439.  
  5440. #ifdef COMPAT_MODE
  5441.     {
  5442.        src = check_file_name(src, 0);
  5443.        if (!src) return 0;
  5444.        strncpy(tmp1, src, sizeof tmp1);
  5445.        tmp1[sizeof tmp1 - 1] = 0;
  5446.        dst = check_file_name(dst, 1);
  5447.        if (!dst) return 0;
  5448.        strncpy(tmp2, dst, sizeof tmp2);
  5449.        tmp2[sizeof tmp2 - 1] = 0;  
  5450.        src = tmp1; dst = tmp2;
  5451.     }
  5452. #else
  5453.     {
  5454.        src = check_valid_path(src, current_object->eff_user, "rename", 0);
  5455.        strcpy(tmp1, src);
  5456.        dst = check_valid_path(dst, current_object->eff_user, "rename", 1);
  5457.        strcpy(tmp2, dst);
  5458.     }
  5459. #endif
  5460.     if (rename(src, dst) == -1)
  5461.     {
  5462.     add_message("rename: %s\n",
  5463.             errno < sys_nerr ? sys_errlist[errno] : "unknown error");
  5464.         return 0;
  5465.     } 
  5466.     return 1;
  5467. }
  5468.  
  5469.  
  5470. int copy_file(src, dst)
  5471.     char *src, *dst;
  5472. {
  5473.     FILE *src_f, *dst_f;
  5474.     int c;
  5475.     char tmp1[500], tmp2[500];
  5476.  
  5477.         /*
  5478.          * right about here, it should have an if (!o_flag) check_valid_path
  5479.          * call, else check_file_name!! Don't know about my syntax though...
  5480.          * --Buddha
  5481.          *
  5482.          * Changed to use COMPAT_MODE -- Raistlin
  5483.          */
  5484. #ifndef COMPAT_MODE
  5485.     src = check_valid_path(src, current_object->eff_user, "copy_file", 0);
  5486. #else
  5487.     src = check_file_name(src, 0);
  5488. #endif
  5489.     if (!src) return 0;
  5490.     strncpy(tmp1, src, sizeof tmp1);
  5491.     tmp1[sizeof tmp1 - 1] = 0;
  5492.  
  5493.         /*
  5494.          * Also there should be one here.
  5495.          */
  5496. #ifndef COMPAT_MODE
  5497.     dst = check_valid_path(dst, current_object->eff_user, "copy_file", 1);
  5498. #else
  5499.     dst = check_file_name(dst, 1);
  5500. #endif
  5501.     if (!dst) return 0;
  5502.     strncpy(tmp2, dst, sizeof tmp2);
  5503.     tmp1[sizeof tmp2 - 1] = 0;
  5504.  
  5505.     src = tmp1; dst = tmp2; 
  5506.  
  5507.     src_f = fopen(src, "r");
  5508.     if (src_f == 0)
  5509.     return 0;
  5510.     dst_f = fopen(dst, "w");
  5511.     if (dst_f == 0) {
  5512.     fclose(src_f);
  5513.     return 0;
  5514.     }
  5515.     while ((c = fgetc(src_f)) != EOF)
  5516.     fputc(c, dst_f);
  5517.     fclose(src_f);
  5518.     fclose(dst_f);
  5519.     return 1;
  5520. }
  5521.  
  5522. struct vector *grab_file(file, start, len)
  5523. char *file;
  5524. int start, len;
  5525. {
  5526.     FILE *f;
  5527.     char buf[257];
  5528.     int line_count=0, char_count=0, i;
  5529.     struct vector *ret;
  5530.  
  5531. #ifndef COMPAT_MODE
  5532.     file = check_valid_path(file, current_object->eff_user, "grab_file", 0);
  5533. #else
  5534.     file = check_file_name(file, 0);
  5535. #endif
  5536.  
  5537.     if (!file)
  5538.     return 0;
  5539.     f = fopen(file, "r");
  5540.     if (f == 0)
  5541.     return 0;
  5542.     if (start < 1) start = 1;
  5543.     if (len < 1 || len > MAX_ARRAY_SIZE) len = MAX_ARRAY_SIZE;
  5544.     while (!feof(f)) 
  5545.     { 
  5546.        fgets(buf, 256, f);
  5547.        if (feof(f)) break;
  5548.        line_count++;
  5549.        char_count += strlen(buf);
  5550.        if (char_count > READ_FILE_MAX_SIZE)
  5551.        {
  5552.           line_count--;
  5553.           break;
  5554.        }
  5555.     }
  5556.     if (start > line_count)
  5557.     {
  5558.        fclose(f);
  5559.        return 0;
  5560.     }
  5561.     rewind(f);
  5562. /* truncate if you try to read past end of file */
  5563.     if ((line_count-start+1) < len)
  5564.        len = line_count-start+1;
  5565.     ret = allocate_array(len);
  5566.     for (i=0; i<(len+start-1); ++i)
  5567.     {
  5568.        char *p;
  5569.        fgets(buf, 256, f); 
  5570.        if (feof(f)) break;
  5571.        if (i < start-1) continue;
  5572.        p = strchr(buf, '\n');
  5573.        if (p) 
  5574.           *p = 0; 
  5575.        else buf[sizeof buf -1] = 0;
  5576.        ret->item[i-start+1].type = T_STRING;
  5577.        ret->item[i-start+1].string_type = STRING_SHARED;
  5578.        ret->item[i-start+1].u.string = make_shared_string(buf);
  5579.     }
  5580.     fclose(f);
  5581.     return ret;
  5582. }
  5583.  
  5584. /* Generate a debug message to the player */
  5585. static void
  5586. do_trace(msg, fname, post)
  5587. char *msg, *fname, *post;
  5588. {
  5589.     char buf[10000];
  5590.     char *objname;
  5591.  
  5592.     if (!TRACEHB)
  5593.     return;
  5594.  
  5595.     if (TRACETST(TRACE_OBJNAME))
  5596.     {
  5597.     if (current_object && current_object->name)
  5598.         objname = current_object->name;
  5599.         else objname = "??";
  5600.     }
  5601.     else objname = "";
  5602.  
  5603.     sprintf(buf, "*** %d %*s %s %s %s%s", tracedepth, tracedepth, "", 
  5604.                   msg, objname, fname, post);
  5605.     add_message(buf);
  5606. }
  5607.  
  5608. struct svalue *apply_master_ob(fun, num_arg)
  5609.     char *fun;
  5610.     int num_arg;
  5611. {
  5612.     extern struct object *master_ob;
  5613.     int save_eval_cost = eval_cost;
  5614.     struct svalue *ret;
  5615.  
  5616.     eval_cost = 0;
  5617.     assert_master_ob_loaded();
  5618.     /*
  5619.      * Maybe apply() should be called instead ?
  5620.      */
  5621.     ret = sapply(fun, master_ob, num_arg);
  5622.     eval_cost = save_eval_cost;
  5623.     return ret;
  5624. }
  5625.  
  5626. void assert_master_ob_loaded()
  5627. {
  5628.     extern struct object *master_ob;
  5629.     static int inside = 0;
  5630. #ifndef COMPAT_MODE
  5631.     struct svalue *ret;
  5632. #endif
  5633.  
  5634.     if (master_ob == 0 || master_ob->flags & O_DESTRUCTED) {
  5635.        /*
  5636.         * The master object has been destructed.  Free our reference,
  5637.         * and load a new one.
  5638.         *
  5639.     * This test is needed because the master object is called from
  5640.     * yyparse() at an error to find the wizard name. However, and error
  5641.     * when loading the master object will cause a recursive call to this
  5642.     * point.  
  5643.     *
  5644.     * The best solution would be if the yyparse() did not have to call
  5645.     * the master object to find the name of the wizard.
  5646.     */
  5647.     if (inside) {
  5648.          fprintf(stderr, "Failed to load master object.\n");
  5649.          add_message("Failed to load master file !\n");
  5650.          exit(1);
  5651.      }
  5652.       fprintf(stderr, "assert_master_ob_loaded: Reloading master.c\n");
  5653.       if (master_ob)
  5654.       free_object(master_ob, "assert_master_ob_loaded");
  5655.       /*
  5656.        * Clear the pointer, in case the load failed.
  5657.        */
  5658.       master_ob = 0;
  5659.       inside = 1;
  5660. #ifdef COMPAT_MODE
  5661.       master_ob = load_object("obj/master", 0);
  5662. #else
  5663.       master_ob = load_object("secure/master", 0);
  5664.  
  5665.       ret = apply_master_ob("get_root_uid", 0);
  5666.       if (ret == 0 || ret->type != T_STRING) 
  5667.            fatal ("get_root_uid() in secure/master.c does not work\n");
  5668.       master_ob->user = add_name(ret->u.string);
  5669.       master_ob->eff_user = master_ob->user;
  5670. #endif
  5671.       inside = 0;
  5672.       add_ref(master_ob, "assert_master_ob_loaded");
  5673.       fprintf(stderr, "Reloading done.\n");
  5674.     }
  5675. }
  5676.  
  5677.  
  5678. /*
  5679. * When an object is destructed, all references to it must be removed
  5680. * from the stack.
  5681. */
  5682. void remove_object_from_stack(ob)
  5683.    struct object *ob;
  5684. {
  5685.    struct svalue *svp;
  5686.  
  5687.    for (svp = start_of_stack; svp <= sp; svp++) {
  5688.     if (svp->type != T_OBJECT)
  5689.         continue;
  5690.     if (svp->u.ob != ob)
  5691.         continue;
  5692.     free_object(svp->u.ob, "remove_object_from_stack");
  5693.     svp->type = T_NUMBER;
  5694.     svp->u.number = 0;
  5695.    }
  5696. }
  5697.  
  5698. static int
  5699. strpref(p, s)
  5700. char *p, *s;
  5701. {
  5702.    while (*p)
  5703.     if (*p++ != *s++)
  5704.         return 0;
  5705.    return 1;
  5706. }
  5707.