/* "Cons" operation */
long
l_cons(long car, long cdr)
{
int s;
if (t_cons_free < 0){ /* no cons cells */
if (gc_protect(car) < 0)
return -1;
if (gc_protect(cdr) < 0)
return -1;
gcollect(); /* invoke garbage collector */
gc_unprotect(cdr);
gc_unprotect(car);
}
/* get a free cons cell from a free list */
s = t_cons_free;
if (t_cons_car[t_cons_free] != t_cons_free)
t_cons_free = t_cons_car[t_cons_free]; /* next free cell */
else
t_cons_free = -1; /* self-loop: end of free list */
/* constract a new cell */
t_cons_car[s] = car;
t_cons_cdr[s] = cdr;
return (TAG_CONS | s);
}
struct object * gcalloc(int sz) {
struct object *result;
memoryPointer = WORDSDOWN(memoryPointer, sz + 2);
if (memoryPointer < memoryBase) {
return gcollect(sz);
}
SETSIZE(memoryPointer, sz);
return(memoryPointer);
}
void gc () /* сбор мусора */
{
register int n;
if (trace)
fputs ("GC...", stderr);
glabelit (T);
glabelit (ZERO);
glabelit (ENV);
n = gcollect ();
if (trace)
fprintf (stderr, "%d OK ", n);
}
void cCommands::KillSpawn(int s, int r) //courtesy of Revana
{
int killed=0;
char temp[512];
r++; // synch with 1-indexed real storage, casue 0 is no region indicator, LB
if (r<=0 || r>=255) return;
sysmessage(s,"Killing spawn, this may cause lag...");
AllCharsIterator iter_char;
for(iter_char.Begin(); iter_char.GetData() != NULL; iter_char++)
{
P_CHAR toCheck = iter_char.GetData();
if(toCheck->spawnregion==r && !toCheck->free)
{
bolteffect(DEREF_P_CHAR(toCheck), true);
soundeffect2(DEREF_P_CHAR(toCheck), 0x00, 0x29);
Npcs->DeleteChar(DEREF_P_CHAR(toCheck));
killed++;
}
}
AllItemsIterator iter_item;
for(iter_item.Begin(); iter_item.GetData() != NULL; iter_item++)
{
P_ITEM toCheck = iter_item.GetData();
if(toCheck->spawnregion == r && !toCheck->free)
{
iter_item--; // Iterator will became invalid when we delete it.
Items->DeleItem(toCheck);
killed++;
}
}
gcollect();
sysmessage(s, "Done.");
sprintf(temp, "%i of Spawn %i have been killed.",killed,r-1);
sysmessage(s, temp);
}
/* Call a built-in function */
long
fcall(long f, long av[2]) /*, int n*/
{
long v, t;
long r, d;
switch (D_GET_DATA(f)){
case KW_RPLACA:
case KW_RPLACD:
case KW_CAR:
case KW_CDR:
if (D_GET_TAG(av[0]) != TAG_CONS)
return err_msg(errmsg_ill_type, 1, f);
break;
case KW_GT:
#ifndef MINIMALISTIC
case KW_LT:
case KW_GTE:
case KW_LTE:
case KW_REM:
#endif
if ((D_GET_TAG(av[0]) != TAG_INT) || (D_GET_TAG(av[1]) != TAG_INT))
return err_msg(errmsg_ill_type, 1, f);
break;
#ifndef MINIMALISTIC
case KW_ZEROP:
case KW_RAND:
case KW_INCR:
case KW_DECR:
if (D_GET_TAG(av[0]) != TAG_INT)
return err_msg(errmsg_ill_type, 1, f);
break;
#endif
}
switch (D_GET_DATA(f)){
#ifndef MINIMALISTIC
case KW_LAMBDA:
return err_msg(errmsg_ill_call, 1, f);
break;
#endif
case KW_QUIT:
quit();
break;
case KW_EQ:
#ifndef MINIMALISTIC
case KW_EQMATH:
#endif
v = (av[0] == av[1]) ? TAG_T : TAG_NIL;
break;
#ifndef MINIMALISTIC
case KW_EQUAL:
return l_equal(av[0], av[1]);
#endif
case KW_CONS:
v = l_cons(av[0], av[1]);
break;
case KW_RPLACA:
v = t_cons_car[D_GET_DATA(av[0])] = av[1];
break;
case KW_RPLACD:
v = t_cons_cdr[D_GET_DATA(av[0])] = av[1];
break;
case KW_CAR:
v = l_car(av[0]);
break;
case KW_CDR:
v = l_cdr(av[0]);
break;
case KW_NULL:
v = (D_GET_TAG(av[0]) == TAG_NIL) ? TAG_T : TAG_NIL;
break;
case KW_CONSP:
return (D_GET_TAG(av[0]) == TAG_CONS) ? TAG_T : TAG_NIL;
case KW_SYMBP:
return (D_GET_TAG(av[0]) == TAG_SYMB) ? TAG_T : TAG_NIL;
case KW_NUMBERP:
v = (D_GET_TAG(av[0]) == TAG_INT) ? TAG_T : TAG_NIL;
break;
case KW_LIST:
v = av[0];
break;
case KW_NOT:
v = (D_GET_TAG(av[0]) == TAG_NIL) ? TAG_T : TAG_NIL;
break;
case KW_READ:
v = l_read();
break;
case KW_EVAL:
v = l_eval(av[0]);
break;
case KW_PRINC:
v = l_print(av[0]);
break;
case KW_TERPRI:
printf("\n");
v = TAG_NIL;
break;
case KW_GC:
gcollect();
v = TAG_T;
break;
case KW_ADD:
for (r = 0, t = av[0]; D_GET_TAG(t) == TAG_CONS; t = l_cdr(t)){
if (D_GET_TAG(l_car(t)) != TAG_INT)
return err_msg(errmsg_ill_type, 1, f);
r = r + int_get_c(l_car(t));
}
v = int_make_l(r);
break;
case KW_TIMES:
for (r = 1, t = av[0]; D_GET_TAG(t) == TAG_CONS; t = l_cdr(t)){
if (D_GET_TAG(l_car(t)) != TAG_INT)
return err_msg(errmsg_ill_type, 1, f);
r = r * int_get_c(l_car(t));
}
v = int_make_l(r);
break;
case KW_SUB:
if (D_GET_TAG(av[0]) == TAG_NIL){
r = 0;
} else if (D_GET_TAG(l_car(av[0])) != TAG_INT){
return err_msg(errmsg_ill_type, 1, f);
} else if (D_GET_TAG(l_cdr(av[0])) == TAG_NIL){
r = 0 - int_get_c(l_car(av[0]));
} else {
r = int_get_c(l_car(av[0]));
for (t = l_cdr(av[0]); D_GET_TAG(t) == TAG_CONS; t = l_cdr(t)){
if (D_GET_TAG(l_car(t)) != TAG_INT)
return err_msg(errmsg_ill_type, 1, f);
r = r - int_get_c(l_car(t));
}
}
v = int_make_l(r);
break;
case KW_QUOTIENT:
if (D_GET_TAG(av[0]) == TAG_NIL){
r = 1;
} else if (D_GET_TAG(l_car(av[0])) != TAG_INT){
return err_msg(errmsg_ill_type, 1, f);
} else if ((d = int_get_c(l_car(av[0]))) == 0){
return err_msg(errmsg_zero_div, 1, f);
} if (D_GET_TAG(l_cdr(av[0])) == TAG_NIL){
r = 1 / d;
} else {
for (r = d, t = l_cdr(av[0]); D_GET_TAG(t) == TAG_CONS; t = l_cdr(t)){
if (D_GET_TAG(l_car(t)) != TAG_INT)
return err_msg(errmsg_ill_type, 1, f);
if ((d = int_get_c(l_car(t))) == 0)
return err_msg(errmsg_zero_div, 1, f);
r = r / d;
}
}
v = int_make_l(r);
break;
case KW_GT:
v = (int_get_c(av[0]) > int_get_c(av[1])) ? TAG_T : TAG_NIL;
break;
#ifndef MINIMALISTIC
case KW_DIVIDE:
r = int_get_c(av[0]);
if ((d = int_get_c(av[1])) == 0)
return err_msg(errmsg_zero_div, 1, f);
v = l_cons(int_make_l(r / d), int_make_l(r % d));
break;
case KW_LT:
v = (int_get_c(av[0]) < int_get_c(av[1])) ? TAG_T : TAG_NIL;
break;
case KW_ATOM:
v = (D_GET_TAG(av[0]) != TAG_CONS) ? TAG_T : TAG_NIL;
break;
case KW_GTE:
v = (int_get_c(av[0]) >= int_get_c(av[1])) ? TAG_T : TAG_NIL;
break;
case KW_LTE:
v = (int_get_c(av[0]) <= int_get_c(av[1])) ? TAG_T : TAG_NIL;
break;
case KW_ZEROP:
v = (int_get_c(av[0]) == 0) ? TAG_T : TAG_NIL;
break;
case KW_RAND:
v = int_make_l(rand() % int_get_c(av[0]));
break;
case KW_INCR:
v = int_make_l(int_get_c(av[0])+1);
break;
case KW_DECR:
v = int_make_l(int_get_c(av[0])-1);
break;
case KW_REM:
r = int_get_c(av[0]);
if ((d = int_get_c(av[1])) == 0)
return err_msg(errmsg_zero_div, 1, f);
v = int_make_l(r % d);
break;
#endif
}
return v;
}
