TODO
int bitwisenot(int x) {
int x_type;
is_number_vector(x);
x_type = MgetVecSubtype(x);
if (x_type == INTEGERSUBTYPE)
return
make_integer(~get_integer_val(x));
else {
not_integer();
return 0;
}
}
int realp(int x) {
if (Mintegerp(x))
return Mtrue;
else
return Mfalse;
}
void MUnaryOp(int op) {
MGetStackArg1();
switch (op) {
case M1_VECTOR_LENGTH_INTEGER:
stack_arg1 = vector_length_integer(stack_arg1);
break;
case M1_DISPLAY:
stack_arg1 = display_(stack_arg1);
break;
case M1_WRITE_CHR:
stack_arg1 = write_chr(stack_arg1);
break;
case M1_CHARNUM:
stack_arg1 = charnum(stack_arg1);
break;
case M1_CHARALPHA:
stack_arg1 = charalpha(stack_arg1);
break;
case M1_CHARUP:
stack_arg1 = charup(stack_arg1);
break;
case M1_CHARDOWN:
stack_arg1 = chardown(stack_arg1);
break;
case M1_MAKE_STRING_INTEGER:
stack_arg1 = make_string_integer(stack_arg1);
break;
case M1_STRING_LENGTH_INTEGER:
stack_arg1 = string_length_integer(stack_arg1);
break;
case M1_STRING_TO_SYMBOL:
stack_arg1 = string_to_symbol(stack_arg1);
break;
case M1_STRING_TO_NUMBER:
stack_arg1 = string_to_number(stack_arg1);
break;
case M1_NUMBER_TO_STRING:
stack_arg1 = number_to_string(stack_arg1);
break;
case M1_SYMBOL_TO_STRING:
stack_arg1 = symbol_to_string(stack_arg1);
break;
case M1_MAKE_VECTOR_INTEGER:
stack_arg1 = make_vector_integer(stack_arg1);
break;
case M1_WRITEOUT:
writeout(stack_arg1);
break;
case M1_CHAR_TO_INT:
stack_arg1 = char_to_int(stack_arg1);
break;
case M1_INTTOCHAR:
stack_arg1 = inttochar(stack_arg1);
break;
case M1_PAIRP:
stack_arg1 = pairp(stack_arg1);
break;
case M1_KAAR:
stack_arg1 = kaar(stack_arg1);
break;
case M1_KDAR:
stack_arg1 = kdar(stack_arg1);
break;
case M1_KADR:
stack_arg1 = kadr(stack_arg1);
break;
case M1_KDDR:
stack_arg1 = kddr(stack_arg1);
break;
case M1_LENGTH_INTEGER:
stack_arg1 = length_integer(stack_arg1);
break;
case M1_BITWISENOT:
stack_arg1 = bitwisenot(stack_arg1);
break;
}
MSetStackArg1(stack_arg1);
MNextInstruction();
return;
}
void MBinaryOp(int op) {
MGetStackArg1();
MGetStackArg2();
switch (op) {
case M2_LIST_REF_INTEGER:
stack_arg1 = list_ref_integer(stack_arg2, stack_arg1);
break;
case M2_RPLACA:
stack_arg1 = rplaca(stack_arg2, stack_arg1);
break;
case M2_RPLACD:
stack_arg1 = rplacd(stack_arg2, stack_arg1);
break;
case M2_STRING_REF_INTEGER:
stack_arg1 = string_ref_integer(stack_arg2, stack_arg1);
break;
case M2_LIST_TAIL_INTEGER:
stack_arg1 = list_tail_integer(stack_arg2, stack_arg1);
break;
case M2_EQV:
stack_arg1 = eqv(stack_arg2, stack_arg1);
break;
case M2_MEMV:
stack_arg1 = memv_(stack_arg2, stack_arg1);
break;
case M2_ASSV:
stack_arg1 = assv_(stack_arg2, stack_arg1);
break;
case M2_MAKE_VECTOR_INTEGER_WITH_FILL:
stack_arg1 = make_vector_integer_with_fill(stack_arg2, stack_arg1);
break;
case M2_MAKE_STRING_INTEGER_WITH_FILL:
stack_arg1 = make_string_integer_with_fill(stack_arg2, stack_arg1);
break;
case M2_MEMQ:
stack_arg1 = memq_(stack_arg2, stack_arg1);
break;
case M2_MEMBER:
stack_arg1 = member_(stack_arg2, stack_arg1);
break;
case M2_ASSQ:
stack_arg1 = assq_(stack_arg2, stack_arg1);
break;
}
MPop();
MSetStackArg1(stack_arg1);
MNextInstruction();
return;
}
void MUnaryPredicate(int op) {
int cc;
MGetStackArg1();
switch (op) {
case M1P_LISTP:
cc = listp(stack_arg1);
break;
case M1P_STRINGP:
cc = stringp(stack_arg1);
break;
case M1P_VECTORP:
cc = vectorp(stack_arg1);
break;
case M1P_EOF_OBJECT:
cc = eof_object(stack_arg1);
break;
case M1P_CHARP:
cc = charp(stack_arg1);
break;
case M1P_PROCEDUREP:
cc = procedurep(stack_arg1);
break;
case M1P_BOOLP:
cc = boolp(stack_arg1);
break;
case M1P_INTEGERP:
cc = integerp(stack_arg1);
break;
}
if (cc != Mfalse)
MSetStackArg1(Mtrue);
else
MSetStackArg1(Mfalse);
MNextInstruction();
return;
}
void MBinaryPredicate(int op) {
int temp;
int temp2;
int cc;
temp = MStackArg2Ref();
temp2 = MStackArg1Ref();
switch (op) {
case M2P_CHAREQ:
cc = chareq(temp, temp2);
break;
case M2P_STRINGEQ:
cc = stringeq(temp, temp2);
break;
case M2P_STRING_LT:
cc = string_lt(temp, temp2);
break;
case M2P_STRING_GT:
cc = string_gt(temp, temp2);
break;
case M2P_STRING_LE:
cc = string_le(temp, temp2);
break;
case M2P_STRING_GE:
cc = string_ge(temp, temp2);
break;
case M2P_STRING_CI_LT:
cc = string_ci_lt(temp, temp2);
break;
case M2P_STRING_CI_GT:
cc = string_ci_gt(temp, temp2);
break;
case M2P_STRING_CI_LE:
cc = string_ci_le(temp, temp2);
break;
case M2P_STRING_CI_GE:
cc = string_ci_ge(temp, temp2);
break;
case M2P_STRING_CI_EQ:
cc = string_ci_eq(temp, temp2);
break;
case M2P_EQUALP:
cc = equalp(temp, temp2);
break;
}
if (cc != Mfalse) {
MPop();
MSetStackArg1(Mtrue);
}
else {
MPop();
MSetStackArg1(Mfalse);
}
MNextInstruction();
return;
}