| 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) */ |
| 1463 |
push_cstring(env, new_string); |
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 |
|
} |
Parent Directory
| 
Revision Log
| 
Patch