1 |
#include "stack.h" |
#include "stack.h" |
2 |
|
#include "messages.h" |
3 |
|
|
4 |
/* Print newline. */ |
/* Print newline. */ |
5 |
extern void nl(environment *env) |
extern void nl(environment *env) |
305 |
/* Clear stack */ |
/* Clear stack */ |
306 |
extern void clear(environment *env) |
extern void clear(environment *env) |
307 |
{ |
{ |
308 |
while(env->head->type != empty) |
env->head= new_val(env); |
|
toss(env); |
|
309 |
} |
} |
310 |
|
|
311 |
/* Forgets a symbol (remove it from the hash table) */ |
/* Forgets a symbol (remove it from the hash table) */ |
1438 |
|
|
1439 |
toss(env); |
toss(env); |
1440 |
} |
} |
1441 |
|
|
1442 |
|
extern void mangle(environment *env) |
1443 |
|
{ |
1444 |
|
char *new_string; |
1445 |
|
|
1446 |
|
if(env->head->type==empty) { |
1447 |
|
printerr("Too Few Arguments"); |
1448 |
|
env->err= 1; |
1449 |
|
return; |
1450 |
|
} |
1451 |
|
|
1452 |
|
if(CAR(env->head)->type!=string) { |
1453 |
|
printerr("Bad Argument Type"); |
1454 |
|
env->err= 2; |
1455 |
|
return; |
1456 |
|
} |
1457 |
|
|
1458 |
|
new_string= mangle_str(CAR(env->head)->content.string); |
1459 |
|
|
1460 |
|
toss(env); |
1461 |
|
if(env->err) return; |
1462 |
|
|
1463 |
|
push_cstring(env, new_string); |
1464 |
|
} |
1465 |
|
|
1466 |
|
/* "fork" */ |
1467 |
|
extern void sx_666f726b(environment *env) |
1468 |
|
{ |
1469 |
|
push_int(env, fork()); |
1470 |
|
} |
1471 |
|
|
1472 |
|
/* "waitpid" */ |
1473 |
|
extern void sx_77616974706964(environment *env) |
1474 |
|
{ |
1475 |
|
|
1476 |
|
if(env->head->type==empty) { |
1477 |
|
printerr("Too Few Arguments"); |
1478 |
|
env->err= 1; |
1479 |
|
return; |
1480 |
|
} |
1481 |
|
|
1482 |
|
if(CAR(env->head)->type!=integer) { |
1483 |
|
printerr("Bad Argument Type"); |
1484 |
|
env->err= 2; |
1485 |
|
return; |
1486 |
|
} |
1487 |
|
|
1488 |
|
push_int(env, waitpid(CAR(env->head)->content.i, NULL, 0)); |
1489 |
|
swap(env); toss(env); |
1490 |
|
} |
1491 |
|
|
1492 |
|
|
1493 |
|
/* Discard the top element of the stack. */ |
1494 |
|
extern void toss(environment *env) |
1495 |
|
{ |
1496 |
|
if(env->head->type==empty) { |
1497 |
|
printerr("Too Few Arguments"); |
1498 |
|
env->err= 1; |
1499 |
|
return; |
1500 |
|
} |
1501 |
|
|
1502 |
|
env->head= CDR(env->head); /* Remove the top stack item */ |
1503 |
|
} |
1504 |
|
|
1505 |
|
|
1506 |
|
/* Quit stack. */ |
1507 |
|
extern void quit(environment *env) |
1508 |
|
{ |
1509 |
|
int i; |
1510 |
|
|
1511 |
|
env->head= new_val(env); |
1512 |
|
|
1513 |
|
if (env->err) return; |
1514 |
|
for(i= 0; i<HASHTBLSIZE; i++) { |
1515 |
|
while(env->symbols[i]!= NULL) { |
1516 |
|
forget_sym(&(env->symbols[i])); |
1517 |
|
} |
1518 |
|
env->symbols[i]= NULL; |
1519 |
|
} |
1520 |
|
|
1521 |
|
env->gc_limit= 0; |
1522 |
|
gc_maybe(env); |
1523 |
|
|
1524 |
|
words(env); |
1525 |
|
|
1526 |
|
if(env->free_string!=NULL) |
1527 |
|
free(env->free_string); |
1528 |
|
|
1529 |
|
#ifdef __linux__ |
1530 |
|
muntrace(); |
1531 |
|
#endif |
1532 |
|
|
1533 |
|
exit(EXIT_SUCCESS); |
1534 |
|
} |
1535 |
|
|
1536 |
|
|
1537 |
|
/* List all defined words */ |
1538 |
|
extern void words(environment *env) |
1539 |
|
{ |
1540 |
|
symbol *temp; |
1541 |
|
int i; |
1542 |
|
|
1543 |
|
for(i= 0; i<HASHTBLSIZE; i++) { |
1544 |
|
temp= env->symbols[i]; |
1545 |
|
while(temp!=NULL) { |
1546 |
|
#ifdef DEBUG |
1547 |
|
if (temp->val != NULL && temp->val->gc.flag.protect) |
1548 |
|
printf("(protected) "); |
1549 |
|
#endif /* DEBUG */ |
1550 |
|
printf("%s ", temp->id); |
1551 |
|
temp= temp->next; |
1552 |
|
} |
1553 |
|
} |
1554 |
|
} |
1555 |
|
|
1556 |
|
|
1557 |
|
/* Only to be called by itself function printstack. */ |
1558 |
|
void print_st(environment *env, value *stack_head, long counter) |
1559 |
|
{ |
1560 |
|
if(CDR(stack_head)->type != empty) |
1561 |
|
print_st(env, CDR(stack_head), counter+1); |
1562 |
|
printf("%ld: ", counter); |
1563 |
|
print_val(env, CAR(stack_head), 0, NULL, stdout); |
1564 |
|
printf("\n"); |
1565 |
|
} |
1566 |
|
|
1567 |
|
|
1568 |
|
/* Prints the stack. */ |
1569 |
|
extern void printstack(environment *env) |
1570 |
|
{ |
1571 |
|
if(env->head->type == empty) { |
1572 |
|
printf("Stack Empty\n"); |
1573 |
|
return; |
1574 |
|
} |
1575 |
|
|
1576 |
|
print_st(env, env->head, 1); |
1577 |
|
} |
1578 |
|
|
1579 |
|
|
1580 |
|
extern void copying(environment *env) |
1581 |
|
{ |
1582 |
|
printf(license_message); |
1583 |
|
} |
1584 |
|
|
1585 |
|
|
1586 |
|
extern void warranty(environment *env) |
1587 |
|
{ |
1588 |
|
printf(warranty_message); |
1589 |
|
} |