/* hasadjective - check to see if an object has a specified adjective */ int hasadjective(int obj,int adjective) { while (obj) { if (inlist(getofield(obj,O_ADJECTIVES),adjective)) return (TRUE); obj = getofield(obj,O_CLASS); } return (FALSE); }
/* hasnoun - check to see if an object has a specified noun */ int hasnoun(int obj,int noun) { while (obj) { if (inlist(getofield(obj,O_NOUNS),noun)) return (TRUE); obj = getofield(obj,O_CLASS); } return (FALSE); }
/* getp - get the value of an object property */ int getp(int obj,int prop) { int p; for (; obj; obj = getofield(obj,O_CLASS)) if (p = findprop(obj,prop)) return (getofield(obj,p)); return (NIL); }
/* findprop - find a property */ int findprop(int obj,int prop) { int n,i,p; n = getofield(obj,O_NPROPERTIES); for (i = p = 0; i < n; i++, p += 4) if ((getofield(obj,O_PROPERTIES+p) & ~P_CLASS) == prop) return (O_PROPERTIES+p+2); return (NIL); }
/* setp - set the value of an object property */ int setp(int obj,int prop,int val) { int p; for (; obj; obj = getofield(obj,O_CLASS)) if (p = findprop(obj,prop)) return (putofield(obj,p,val)); return (NIL); }
/* exe_one - execute one instruction */ void exe_one(void) { /* get the opcode */ opcode = getcbyte(pc); pc++; /* execute the instruction */ switch (opcode) { case OP_CALL: *--sp = getboperand(); *--sp = pc; *--sp = (int)(top - fp); fp = sp; pc = getafield(fp[fp[2]+3],A_CODE); break; case OP_SEND: *--sp = getboperand(); *--sp = pc; *--sp = (int)(top - fp); fp = sp; if (p2 = fp[fp[2]+3]) p2 = getofield(p2,O_CLASS); else p2 = fp[fp[2]+2]; if (p2 && (p2 = getp(p2,fp[fp[2]+1]))) { pc = getafield(p2,A_CODE); break; } *sp = NIL; /* return NIL if there is no method for this message */ case OP_RETURN: if (fp == top) sts = CHAIN; else { p2 = *sp; sp = fp; fp = top - *sp++; pc = *sp++; p3 = *sp++; sp += p3; *sp = p2; } break; case OP_TSPACE: sp -= getboperand(); break; case OP_TMP: p2 = getboperand(); *sp = fp[-p2-1]; break; case OP_TSET: p2 = getboperand(); fp[-p2-1] = *sp; break; case OP_ARG: p2 = getboperand(); if (p2 >= fp[2]) error("too few arguments"); *sp = fp[p2+3]; break; case OP_ASET: p2 = getboperand(); if (p2 >= fp[2]) error("too few arguments"); fp[p2+3] = *sp; break; case OP_BRT: pc = (*sp ? getwoperand() : pc+2); break; case OP_BRF: pc = (*sp ? pc+2 : getwoperand()); break; case OP_BR: pc = getwoperand(); break; case OP_T: *sp = T; break; case OP_NIL: *sp = NIL; break; case OP_PUSH: *--sp = NIL; break; case OP_NOT: *sp = (*sp ? NIL : T); break; case OP_ADD: p2 = *sp++; *sp += p2; break; case OP_SUB: p2 = *sp++; *sp -= p2; break; case OP_MUL: p2 = *sp++; *sp *= p2; break; case OP_DIV: p2 = *sp++; *sp = (p2 == 0 ? 0 : *sp / p2); break; case OP_REM: p2 = *sp++; *sp = (p2 == 0 ? 0 : *sp % p2); break; case OP_BAND: p2 = *sp++; *sp &= p2; break; case OP_BOR: p2 = *sp++; *sp |= p2; break; case OP_BNOT: *sp = ~*sp; break; case OP_LT: p2 = *sp++; *sp = (*sp < p2 ? T : NIL); break; case OP_EQ: p2 = *sp++; *sp = (*sp == p2 ? T : NIL); break; case OP_GT: p2 = *sp++; *sp = (*sp > p2 ? T : NIL); break; case OP_LIT: *sp = getwoperand(); break; case OP_SPLIT: *sp = getboperand(); break; case OP_SNLIT: *sp = -getboperand(); break; case OP_VAR: *sp = getvalue(getwoperand()); break; case OP_SVAR: *sp = getvalue(getboperand()); break; case OP_SET: setvalue(getwoperand(),*sp); break; case OP_SSET: setvalue(getboperand(),*sp); break; case OP_GETP: p2 = *sp++; *sp = getp(*sp,p2); break; case OP_SETP: p3 = *sp++; p2 = *sp++; *sp = setp(*sp,p2,p3); break; case OP_PRINT: print(*sp); break; case OP_PNUMBER: pnumber(*sp); break; case OP_PNOUN: show_noun(*sp); break; case OP_TERPRI: trm_chr('\n'); break; case OP_FINISH: sts = FINISH; break; case OP_CHAIN: sts = CHAIN; break; case OP_ABORT: sts = ABORT; break; case OP_EXIT: #ifdef MAC macpause(); #endif trm_done(); exit(); break; case OP_YORN: trm_get(line); *sp = (line[0] == 'Y' || line[0] == 'y' ? T : NIL); break; case OP_CLASS: *sp = getofield(*sp,O_CLASS); break; case OP_MATCH: p2 = *sp++; *sp = (match(*sp,nouns[p2-1],adjectives[p2-1]) ? T : NIL); break; case OP_SAVE: *sp = db_save(); break; case OP_RESTORE: *sp = db_restore(); break; case OP_RESTART: *sp = db_restart(); break; case OP_RAND: *sp = getrand(*sp); break; case OP_RNDMIZE: setrand(time(0L)); *sp = NIL; break; default: if (opcode >= OP_XVAR && opcode < OP_XSET) *sp = getvalue(opcode - OP_XVAR); else if (opcode >= OP_XSET && opcode < OP_XPLIT) setvalue(opcode - OP_XSET,*sp); else if (opcode >= OP_XPLIT && opcode < OP_XNLIT) *sp = opcode - OP_XPLIT; else if (opcode >= OP_XNLIT && opcode < 256) *sp = OP_XNLIT - opcode; else trm_str("Bad opcode\n"); break; } }