24 |
IMPLEMENTATION-DEPENDENT |
IMPLEMENTATION-DEPENDENT |
25 |
*/ |
*/ |
26 |
|
|
27 |
|
#include <unistd.h> |
28 |
#include <string.h> |
#include <string.h> |
29 |
|
|
30 |
#define IN_MAIN |
#define IN_MAIN |
97 |
int cssize; |
int cssize; |
98 |
|
|
99 |
int sgc_enabled; |
int sgc_enabled; |
100 |
void install_segmentation_catcher(); |
void install_segmentation_catcher(void); |
101 |
|
|
102 |
#ifndef SIG_STACK_SIZE |
#ifndef SIG_STACK_SIZE |
103 |
#define SIG_STACK_SIZE 1000 |
#define SIG_STACK_SIZE 1000 |
108 |
#endif |
#endif |
109 |
#endif |
#endif |
110 |
|
|
111 |
main(argc, argv, envp) |
int |
112 |
int argc; |
main(int argc, char **argv, char **envp) { |
|
char **argv, **envp; |
|
|
{ |
|
|
FILE *i; |
|
|
unsigned int dummy; |
|
113 |
#ifdef BSD |
#ifdef BSD |
114 |
#ifdef RLIMIT_STACK |
#ifdef RLIMIT_STACK |
115 |
struct rlimit rl; |
struct rlimit rl; |
116 |
#endif |
#endif |
117 |
#endif |
#endif |
|
#if defined(HAVE_SIGACTION) || defined(HAVE_SIGVEC) |
|
|
|
|
|
#ifdef SETJMP_ONE_DIRECTION |
|
|
static |
|
|
#endif |
|
|
/* make sure the stack is 8 byte aligned */ |
|
|
double estack_buf[SIG_STACK_SIZE]; |
|
|
#endif |
|
118 |
|
|
119 |
#ifdef RECREATE_HEAP |
#ifdef RECREATE_HEAP |
120 |
RECREATE_HEAP |
RECREATE_HEAP |
121 |
#endif |
#endif |
122 |
|
|
123 |
#ifdef _WIN32 |
#ifdef _WIN32 |
124 |
_stackbottom = (unsigned int ) &dummy; |
{ |
125 |
_stacktop = _stackbottom - 0x10000; // ??? |
unsigned int dummy; |
126 |
|
|
127 |
|
_stackbottom = (unsigned int ) &dummy; |
128 |
|
_stacktop = _stackbottom - 0x10000; // ??? |
129 |
|
|
130 |
|
} |
131 |
#endif |
#endif |
132 |
setbuf(stdin, stdin_buf); |
setbuf(stdin, stdin_buf); |
133 |
setbuf(stdout, stdout_buf); |
setbuf(stdout, stdout_buf); |
252 |
SETUP_SIG_STACK |
SETUP_SIG_STACK |
253 |
#else |
#else |
254 |
#if defined(HAVE_SIGACTION) || defined(HAVE_SIGVEC) |
#if defined(HAVE_SIGACTION) || defined(HAVE_SIGVEC) |
255 |
bzero(estack_buf,sizeof(estack_buf)); |
{ |
256 |
estack.ss_sp = (char *) &estack_buf[SIG_STACK_SIZE-1]; |
/* make sure the stack is 8 byte aligned */ |
257 |
estack.ss_onstack=0; |
#ifdef SETJMP_ONE_DIRECTION |
258 |
sigstack(&estack,0); |
static |
259 |
|
#endif |
260 |
|
double estack_buf[SIG_STACK_SIZE]; |
261 |
|
|
262 |
|
bzero(estack_buf,sizeof(estack_buf)); |
263 |
|
estack.ss_sp = (char *) &estack_buf[SIG_STACK_SIZE-1]; |
264 |
|
estack.ss_onstack=0; |
265 |
|
sigstack(&estack,0); |
266 |
|
} |
267 |
#endif |
#endif |
268 |
#endif |
#endif |
269 |
|
|
341 |
|
|
342 |
super_funcall(sStop_level); |
super_funcall(sStop_level); |
343 |
|
|
344 |
|
return 0; |
345 |
|
|
346 |
} |
} |
347 |
|
|
348 |
/* catch certain signals */ |
/* catch certain signals */ |
349 |
void install_segmentation_catcher() |
void install_segmentation_catcher(void) |
350 |
{ |
{ |
351 |
#ifdef INSTALL_SEGMENTATION_CATCHER |
#ifdef INSTALL_SEGMENTATION_CATCHER |
352 |
INSTALL_SEGMENTATION_CATCHER; |
INSTALL_SEGMENTATION_CATCHER; |
359 |
|
|
360 |
int catch_fatal=1; |
int catch_fatal=1; |
361 |
void |
void |
362 |
error(s) |
error(char *s) |
|
char *s; |
|
363 |
{ |
{ |
364 |
if (catch_fatal>0 && interrupt_enable ) |
if (catch_fatal>0 && interrupt_enable ) |
365 |
{catch_fatal = -1; |
{catch_fatal = -1; |
375 |
#endif |
#endif |
376 |
} |
} |
377 |
|
|
378 |
|
void |
379 |
|
initlisp(void) { |
380 |
|
|
|
initlisp() |
|
|
{ |
|
381 |
int j; |
int j; |
382 |
|
|
383 |
if (NULL_OR_ON_C_STACK(&j) == 0 |
if (NULL_OR_ON_C_STACK(&j) == 0 |
518 |
|
|
519 |
} |
} |
520 |
object |
object |
521 |
vs_overflow() |
vs_overflow(void) |
522 |
{ |
{ |
523 |
if (vs_limit > vs_org + stack_multiple * VSSIZE) |
if (vs_limit > vs_org + stack_multiple * VSSIZE) |
524 |
error("value stack overflow"); |
error("value stack overflow"); |
525 |
vs_limit += STACK_OVER*VSGETA; |
vs_limit += STACK_OVER*VSGETA; |
526 |
FEerror("Value stack overflow.", 0);return Cnil; |
FEerror("Value stack overflow.", 0); |
527 |
|
return Cnil; |
528 |
} |
} |
529 |
|
|
530 |
|
void |
531 |
bds_overflow() |
bds_overflow(void) { |
|
{ |
|
532 |
--bds_top; |
--bds_top; |
533 |
if (bds_limit > bds_org + stack_multiple * BDSSIZE) |
if (bds_limit > bds_org + stack_multiple * BDSSIZE) |
534 |
error("bind stack overflow"); |
error("bind stack overflow"); |
536 |
FEerror("Bind stack overflow.", 0); |
FEerror("Bind stack overflow.", 0); |
537 |
} |
} |
538 |
|
|
539 |
frs_overflow() |
void |
540 |
{ |
frs_overflow(void) { |
541 |
--frs_top; |
--frs_top; |
542 |
if (frs_limit > frs_org + stack_multiple * FRSSIZE) |
if (frs_limit > frs_org + stack_multiple * FRSSIZE) |
543 |
error("frame stack overflow"); |
error("frame stack overflow"); |
545 |
FEerror("Frame stack overflow.", 0); |
FEerror("Frame stack overflow.", 0); |
546 |
} |
} |
547 |
|
|
548 |
ihs_overflow() |
void |
549 |
{ |
ihs_overflow(void) { |
550 |
--ihs_top; |
--ihs_top; |
551 |
if (ihs_limit > ihs_org + stack_multiple * IHSSIZE) |
if (ihs_limit > ihs_org + stack_multiple * IHSSIZE) |
552 |
error("invocation history stack overflow"); |
error("invocation history stack overflow"); |
555 |
} |
} |
556 |
|
|
557 |
void |
void |
558 |
segmentation_catcher() |
segmentation_catcher(int i) { |
|
{int x; |
|
559 |
#ifndef SIG_STACK_SIZE |
#ifndef SIG_STACK_SIZE |
560 |
if (&x < cs_limit) |
int x; |
561 |
cs_overflow(); |
if (&x < cs_limit) |
562 |
else |
cs_overflow(); |
563 |
{printf("Segmentation violation: c stack ok:signalling error"); |
else |
564 |
} |
printf("Segmentation violation: c stack ok:signalling error"); |
565 |
#endif |
#endif |
566 |
error("Segmentation violation."); |
error("Segmentation violation."); |
567 |
} |
} |
568 |
|
|
569 |
cs_overflow() |
void |
570 |
{ |
cs_overflow(void) { |
571 |
#ifdef AV |
#ifdef AV |
572 |
if (cs_limit < cs_org - cssize) |
if (cs_limit < cs_org - cssize) |
573 |
error("control stack overflow"); |
error("control stack overflow"); |
581 |
FEerror("Control stack overflow.", 0); |
FEerror("Control stack overflow.", 0); |
582 |
} |
} |
583 |
|
|
584 |
end_of_file() |
void |
585 |
{ |
end_of_file(void) { |
586 |
error("end of file"); |
error("end of file"); |
587 |
} |
} |
588 |
|
|
589 |
DEFUNO("BYE",int,fLbye,LISP |
DEFUNO("BYE",object,fLbye,LISP |
590 |
,0,1,NONE,II,OO,OO,OO,Lby,"")(va_alist) |
,0,1,NONE,OI,OO,OO,OO,Lby,"")(va_alist) |
591 |
va_dcl |
va_dcl |
592 |
{ int n=VFUN_NARGS; |
{ int n=VFUN_NARGS; |
593 |
int exit_code; |
int exit_code; |
601 |
#ifdef UNIX |
#ifdef UNIX |
602 |
/* printf("Bye.\n"); */ |
/* printf("Bye.\n"); */ |
603 |
exit(exit_code); |
exit(exit_code); |
604 |
|
#else |
605 |
|
RETURN(1,int,exit_code, 0); |
606 |
#endif |
#endif |
607 |
|
|
|
RETURN(1,int,exit_code, 0); |
|
608 |
} |
} |
609 |
|
|
610 |
DEFUNO("QUIT",int,fLquit,LISP |
DEFUNO("QUIT",object,fLquit,LISP |
611 |
,0,1,NONE,II,OO,OO,OO,Lquit,"")(va_alist) |
,0,1,NONE,OI,OO,OO,OO,Lquit,"")(va_alist) |
612 |
va_dcl |
va_dcl |
613 |
{ return fLbye(va_alist); } |
{ return fLbye(va_alist); } |
614 |
|
|
615 |
DEFUNO("EXIT",int,fLexit,LISP |
DEFUNO("EXIT",object,fLexit,LISP |
616 |
,0,1,NONE,II,OO,OO,OO,Lexit,"")(va_alist) |
,0,1,NONE,OI,OO,OO,OO,Lexit,"")(va_alist) |
617 |
va_dcl |
va_dcl |
618 |
{ return fLbye(va_alist); } |
{ return fLbye(va_alist); } |
619 |
|
|
620 |
|
|
621 |
c_trace() |
/* c_trace(void) */ |
622 |
{ |
/* { */ |
623 |
#ifdef AOSVS |
/* #ifdef AOSVS */ |
624 |
|
|
625 |
#endif |
/* #endif */ |
626 |
} |
/* } */ |
627 |
|
|
628 |
siLargc() |
void |
629 |
{ |
siLargc(void) { |
630 |
check_arg(0); |
check_arg(0); |
631 |
vs_push(make_fixnum(ARGC)); |
vs_push(make_fixnum(ARGC)); |
632 |
} |
} |
633 |
|
|
634 |
siLargv() |
void |
635 |
{ |
siLargv(void) { |
636 |
int i; |
int i=0; |
637 |
|
|
638 |
|
check_arg(1); |
639 |
|
if (type_of(vs_base[0]) != t_fixnum || |
640 |
|
(i = fix(vs_base[0])) < 0 || |
641 |
|
i >= ARGC) |
642 |
|
FEerror("Illegal argument index: ~S.", 1, vs_base[0]); |
643 |
|
vs_base[0] = make_simple_string(ARGV[i]); |
644 |
|
|
|
check_arg(1); |
|
|
if (type_of(vs_base[0]) != t_fixnum || |
|
|
(i = fix(vs_base[0])) < 0 || |
|
|
i >= ARGC) |
|
|
FEerror("Illegal argument index: ~S.", 1, vs_base[0]); |
|
|
vs_base[0] = make_simple_string(ARGV[i]); |
|
645 |
} |
} |
646 |
|
|
647 |
#ifdef UNIX |
#ifdef UNIX |
648 |
siLgetenv() |
void |
649 |
{ |
siLgetenv(void) { |
650 |
char name[256]; |
|
651 |
int i; |
char name[256]; |
652 |
char *value; |
int i; |
653 |
extern char *getenv(); |
char *value; |
654 |
|
extern char *getenv(const char *); |
655 |
check_arg(1); |
|
656 |
check_type_string(&vs_base[0]); |
check_arg(1); |
657 |
if (vs_base[0]->st.st_fillp >= 256) |
check_type_string(&vs_base[0]); |
658 |
FEerror("Too long name: ~S.", 1, vs_base[0]); |
if (vs_base[0]->st.st_fillp >= 256) |
659 |
for (i = 0; i < vs_base[0]->st.st_fillp; i++) |
FEerror("Too long name: ~S.", 1, vs_base[0]); |
660 |
name[i] = vs_base[0]->st.st_self[i]; |
for (i = 0; i < vs_base[0]->st.st_fillp; i++) |
661 |
name[i] = '\0'; |
name[i] = vs_base[0]->st.st_self[i]; |
662 |
if ((value = getenv(name)) != NULL) |
name[i] = '\0'; |
663 |
{vs_base[0] = make_simple_string(value); |
if ((value = getenv(name)) != NULL) |
664 |
|
{vs_base[0] = make_simple_string(value); |
665 |
#ifdef FREE_GETENV_RESULT |
#ifdef FREE_GETENV_RESULT |
666 |
free(value); |
free(value); |
667 |
|
|
668 |
#endif |
#endif |
669 |
} |
} |
670 |
else |
else |
671 |
vs_base[0] = Cnil; |
vs_base[0] = Cnil; |
672 |
|
|
673 |
} |
} |
674 |
#endif |
#endif |
675 |
|
|
676 |
object *vs_marker; |
object *vs_marker; |
677 |
|
|
678 |
siLmark_vs() |
void |
679 |
{ |
siLmark_vs(void) { |
680 |
check_arg(0); |
check_arg(0); |
681 |
vs_marker = vs_base; |
vs_marker = vs_base; |
682 |
vs_base[0] = Cnil; |
vs_base[0] = Cnil; |
683 |
} |
} |
684 |
|
|
685 |
siLcheck_vs() |
void |
686 |
{ |
siLcheck_vs(void) { |
687 |
check_arg(0); |
check_arg(0); |
688 |
if (vs_base != vs_marker) |
if (vs_base != vs_marker) |
689 |
FEerror("Value stack is flawed.", 0); |
FEerror("Value stack is flawed.", 0); |
690 |
vs_base[0] = Cnil; |
vs_base[0] = Cnil; |
691 |
} |
} |
692 |
|
|
693 |
object |
object |
694 |
siLcatch_fatal(i) |
siLcatch_fatal(int i) { |
695 |
{catch_fatal=i; |
catch_fatal=i; |
696 |
return Cnil;} |
return Cnil; |
697 |
|
} |
698 |
|
|
699 |
|
static void |
700 |
|
reset_cstack_limit(int arg) { |
701 |
|
#ifdef AV |
702 |
|
if (&arg > cs_org - cssize + 16) |
703 |
|
cs_limit = cs_org - cssize; |
704 |
|
else |
705 |
|
error("can't reset cs_limit"); |
706 |
|
#endif |
707 |
|
} |
708 |
|
|
709 |
void |
void |
710 |
siLreset_stack_limits(arg) |
siLreset_stack_limits(void) |
|
int arg; |
|
711 |
{ |
{ |
712 |
check_arg(0); |
int i=0; |
713 |
if(catch_fatal <0) catch_fatal=1; |
|
714 |
|
check_arg(0); |
715 |
|
if(catch_fatal <0) catch_fatal=1; |
716 |
#ifdef SGC |
#ifdef SGC |
717 |
{extern int fault_count ; fault_count = 0;} |
{extern int fault_count ; fault_count = 0;} |
718 |
#endif |
#endif |
719 |
if (vs_top < vs_org + stack_multiple * VSSIZE) |
if (vs_top < vs_org + stack_multiple * VSSIZE) |
720 |
vs_limit = vs_org + stack_multiple * VSSIZE; |
vs_limit = vs_org + stack_multiple * VSSIZE; |
721 |
else |
else |
722 |
error("can't reset vs_limit"); |
error("can't reset vs_limit"); |
723 |
if (bds_top < bds_org + stack_multiple * BDSSIZE) |
if (bds_top < bds_org + stack_multiple * BDSSIZE) |
724 |
bds_limit = bds_org + stack_multiple * BDSSIZE; |
bds_limit = bds_org + stack_multiple * BDSSIZE; |
725 |
else |
else |
726 |
error("can't reset bds_limit"); |
error("can't reset bds_limit"); |
727 |
if (frs_top < frs_org + stack_multiple * FRSSIZE) |
if (frs_top < frs_org + stack_multiple * FRSSIZE) |
728 |
frs_limit = frs_org + stack_multiple * FRSSIZE; |
frs_limit = frs_org + stack_multiple * FRSSIZE; |
729 |
else |
else |
730 |
error("can't reset frs_limit"); |
error("can't reset frs_limit"); |
731 |
if (ihs_top < ihs_org + stack_multiple * IHSSIZE) |
if (ihs_top < ihs_org + stack_multiple * IHSSIZE) |
732 |
ihs_limit = ihs_org + stack_multiple * IHSSIZE; |
ihs_limit = ihs_org + stack_multiple * IHSSIZE; |
733 |
else |
else |
734 |
error("can't reset ihs_limit"); |
error("can't reset ihs_limit"); |
735 |
#ifdef AV |
reset_cstack_limit(i); |
736 |
if (&arg > cs_org - cssize + 16) |
vs_base[0] = Cnil; |
|
cs_limit = cs_org - cssize; |
|
|
|
|
|
else |
|
|
error("can't reset cs_limit"); |
|
|
#endif |
|
|
vs_base[0] = Cnil; |
|
737 |
} |
} |
738 |
|
|
739 |
#define COPYSTACK(org,p,typ,lim,top,geta,size) \ |
#define COPYSTACK(org,p,typ,lim,top,geta,size) \ |
745 |
lim = ((typ *)p) - (STACK_OVER+1)*geta; \ |
lim = ((typ *)p) - (STACK_OVER+1)*geta; \ |
746 |
}while (0) |
}while (0) |
747 |
|
|
748 |
multiply_stacks(m) |
int |
749 |
int m; |
multiply_stacks(int m) { |
750 |
{ int n; |
/* int n; */ |
751 |
object x; |
/* object x; */ |
752 |
object gc_pro=stack_space; |
/* object gc_pro=stack_space; */ |
753 |
char *p; |
char *p; |
754 |
int vs,bd,frs,ihs; |
int vs,bd,frs,ihs; |
755 |
stack_multiple=stack_multiple*m; |
stack_multiple=stack_multiple*m; |
756 |
#define ELTSIZE(x) (((char *)((x)+1)) - ((char *) x)) |
#define ELTSIZE(x) (((char *)((x)+1)) - ((char *) x)) |
757 |
vs = (stack_multiple*VSSIZE + (STACK_OVER+1)*VSGETA)* ELTSIZE(vs_org); |
vs = (stack_multiple*VSSIZE + (STACK_OVER+1)*VSGETA)* ELTSIZE(vs_org); |
758 |
bd = (stack_multiple*BDSSIZE + (STACK_OVER+1)*BDSGETA)*ELTSIZE(bds_org); |
bd = (stack_multiple*BDSSIZE + (STACK_OVER+1)*BDSGETA)*ELTSIZE(bds_org); |
759 |
frs = (stack_multiple*FRSSIZE + (STACK_OVER+1)*FRSGETA)*ELTSIZE(frs_org); |
frs = (stack_multiple*FRSSIZE + (STACK_OVER+1)*FRSGETA)*ELTSIZE(frs_org); |
760 |
ihs = (stack_multiple*IHSSIZE + (STACK_OVER+1)*IHSGETA)*ELTSIZE(ihs_org); |
ihs = (stack_multiple*IHSSIZE + (STACK_OVER+1)*IHSGETA)*ELTSIZE(ihs_org); |
761 |
if (stack_space==0) {enter_mark_origin(&stack_space);} |
if (stack_space==0) {enter_mark_origin(&stack_space);} |
762 |
stack_space = alloc_simple_string(vs+bd+frs+ihs); |
stack_space = alloc_simple_string(vs+bd+frs+ihs); |
763 |
array_allocself(stack_space,1,code_char(0)); |
array_allocself(stack_space,1,code_char(0)); |
764 |
p=stack_space->st.st_self; |
p=stack_space->st.st_self; |
765 |
COPYSTACK(vs_org,p,object,vs_limit,vs_top,VSGETA,VSSIZE); |
COPYSTACK(vs_org,p,object,vs_limit,vs_top,VSGETA,VSSIZE); |
766 |
COPYSTACK(bds_org,p,struct bds_bd,bds_limit,bds_top,BDSGETA,BDSSIZE); |
COPYSTACK(bds_org,p,struct bds_bd,bds_limit,bds_top,BDSGETA,BDSSIZE); |
767 |
COPYSTACK(frs_org,p,struct frame,frs_limit,frs_top,FRSGETA,FRSSIZE); |
COPYSTACK(frs_org,p,struct frame,frs_limit,frs_top,FRSGETA,FRSSIZE); |
768 |
COPYSTACK(ihs_org,p,struct invocation_history,ihs_limit,ihs_top, |
COPYSTACK(ihs_org,p,struct invocation_history,ihs_limit,ihs_top, |
769 |
IHSGETA,IHSSIZE); |
IHSGETA,IHSSIZE); |
770 |
vs_base=vs_top; |
vs_base=vs_top; |
771 |
return stack_multiple; |
return stack_multiple; |
772 |
} |
} |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
773 |
|
|
774 |
siLinit_system() |
void |
775 |
{ |
siLinit_system(void) { |
776 |
check_arg(0); |
check_arg(0); |
777 |
init_system(); |
init_system(); |
778 |
vs_base[0] = Cnil; |
vs_base[0] = Cnil; |
779 |
} |
} |
780 |
|
|
781 |
siLaddress() |
void |
782 |
{ |
siLaddress(void) { |
783 |
check_arg(1); |
check_arg(1); |
784 |
vs_base[0] = make_fixnum((long)vs_base[0]); |
vs_base[0] = make_fixnum((long)vs_base[0]); |
785 |
} |
} |
786 |
|
|
787 |
siLnani() |
void |
788 |
{ |
siLnani(void) { |
789 |
check_arg(1); |
check_arg(1); |
790 |
vs_base[0] = (object)fixint(vs_base[0]); |
vs_base[0] = (object)fixint(vs_base[0]); |
791 |
} |
} |
792 |
|
|
793 |
siLinitialization_failure() |
void |
794 |
{ |
siLinitialization_failure(void) { |
795 |
check_arg(0); |
check_arg(0); |
796 |
printf("lisp initialization failed\n"); |
printf("lisp initialization failed\n"); |
797 |
exit(0); |
exit(0); |
798 |
} |
} |
799 |
|
|
800 |
DEFUNO("IDENTITY",object,fLidentity,LISP |
DEFUNO("IDENTITY",object,fLidentity,LISP |
809 |
,0,0,NONE,OO,OO,OO,OO,Llisp_implementation_version,"")() |
,0,0,NONE,OO,OO,OO,OO,Llisp_implementation_version,"")() |
810 |
{ |
{ |
811 |
/* 0 args */ |
/* 0 args */ |
|
|
|
812 |
RETURN1((make_simple_string(LISP_IMPLEMENTATION_VERSION))); |
RETURN1((make_simple_string(LISP_IMPLEMENTATION_VERSION))); |
813 |
} |
} |
814 |
|
|
815 |
|
|
816 |
siLsave_system() |
void |
817 |
{ |
siLsave_system(void) { |
818 |
int i; |
int i; |
819 |
|
|
820 |
#ifdef HAVE_YP_UNBIND |
#ifdef HAVE_YP_UNBIND |
821 |
extern object truename(),namestring(); |
extern object truename(),namestring(); |
822 |
check_arg(1); |
check_arg(1); |
823 |
/* prevent subsequent consultation of yp by getting |
/* prevent subsequent consultation of yp by getting |
824 |
truename now*/ |
truename now*/ |
825 |
vs_base[0]=namestring(truename(vs_base[0])); |
vs_base[0]=namestring(truename(vs_base[0])); |
826 |
{char name[200]; |
{char name[200]; |
827 |
char *dom = name; |
char *dom = name; |
828 |
if (0== getdomainname(dom,sizeof(name))) |
if (0== getdomainname(dom,sizeof(name))) |
829 |
yp_unbind(dom);} |
yp_unbind(dom);} |
830 |
#endif |
#endif |
831 |
|
|
832 |
#ifdef DO_BEFORE_SAVE |
#ifdef DO_BEFORE_SAVE |
833 |
DO_BEFORE_SAVE |
DO_BEFORE_SAVE |
834 |
#endif |
#endif |
835 |
|
|
836 |
saving_system = TRUE; |
saving_system = TRUE; |
837 |
GBC(t_contiguous); |
GBC(t_contiguous); |
838 |
|
|
839 |
|
|
840 |
|
|
841 |
#if defined(BSD) || defined(ATT) |
#if defined(BSD) || defined(ATT) |
842 |
brk(core_end); |
brk(core_end); |
843 |
/* printf( "(breaking at core_end = %x in main ,)",core_end); */ |
/* printf( "(breaking at core_end = %x in main ,)",core_end); */ |
844 |
#endif |
#endif |
845 |
|
|
846 |
|
/* #ifdef DGUX */ |
847 |
|
|
848 |
|
/* #endif */ |
849 |
|
|
850 |
|
/* #ifdef AOSVS */ |
851 |
|
|
852 |
|
|
853 |
|
|
854 |
|
|
855 |
|
/* #endif */ |
856 |
|
cbgbccount = 0; |
857 |
|
rbgbccount = 0; |
858 |
|
for (i = 0; i < (int)t_end; i++) |
859 |
|
tm_table[i].tm_gbccount = 0; |
860 |
|
Lsave(); |
861 |
|
saving_system = FALSE; |
862 |
|
alloc_page(-(holepage+nrbpage)); |
863 |
|
|
|
#ifdef DGUX |
|
|
|
|
|
#endif |
|
|
|
|
|
#ifdef AOSVS |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
#endif |
|
|
cbgbccount = 0; |
|
|
rbgbccount = 0; |
|
|
for (i = 0; i < (int)t_end; i++) |
|
|
tm_table[i].tm_gbccount = 0; |
|
|
Lsave(); |
|
|
saving_system = FALSE; |
|
|
alloc_page(-(holepage+nrbpage)); |
|
864 |
} |
} |
865 |
|
|
866 |
DEFVAR("*LISP-MAXPAGES*",sSAlisp_maxpagesA,SI,make_fixnum(real_maxpage),""); |
DEFVAR("*LISP-MAXPAGES*",sSAlisp_maxpagesA,SI,make_fixnum(real_maxpage),""); |
869 |
DEF_ORDINARY("TOP-LEVEL",sStop_level,SI,""); |
DEF_ORDINARY("TOP-LEVEL",sStop_level,SI,""); |
870 |
DEFVAR("*COMMAND-ARGS*",sSAcommand_argsA,SI,sLnil,""); |
DEFVAR("*COMMAND-ARGS*",sSAcommand_argsA,SI,sLnil,""); |
871 |
|
|
872 |
init_main() |
void |
873 |
{ |
init_main(void) { |
|
make_function("BY", Lby); |
|
|
make_si_function("ARGC", siLargc); |
|
|
make_si_function("ARGV", siLargv); |
|
874 |
|
|
875 |
|
make_function("BY", Lby); |
876 |
|
make_si_function("ARGC", siLargc); |
877 |
|
make_si_function("ARGV", siLargv); |
878 |
|
|
879 |
#ifdef UNIX |
#ifdef UNIX |
880 |
make_si_function("GETENV", siLgetenv); |
make_si_function("GETENV", siLgetenv); |
881 |
#endif |
#endif |
882 |
|
|
883 |
make_si_function("MARK-VS", siLmark_vs); |
make_si_function("MARK-VS", siLmark_vs); |
884 |
make_si_function("CHECK-VS", siLcheck_vs); |
make_si_function("CHECK-VS", siLcheck_vs); |
885 |
make_si_function("RESET-STACK-LIMITS", siLreset_stack_limits); |
make_si_function("RESET-STACK-LIMITS", siLreset_stack_limits); |
886 |
make_si_function("INIT-SYSTEM", siLinit_system); |
make_si_function("INIT-SYSTEM", siLinit_system); |
887 |
make_si_function("ADDRESS", siLaddress); |
make_si_function("ADDRESS", siLaddress); |
888 |
make_si_function("NANI", siLnani); |
make_si_function("NANI", siLnani); |
889 |
make_si_function("INITIALIZATION-FAILURE", |
make_si_function("INITIALIZATION-FAILURE", |
890 |
siLinitialization_failure); |
siLinitialization_failure); |
891 |
|
|
892 |
siClisp_pagesize = |
siClisp_pagesize = |
893 |
make_si_constant("LISP-PAGESIZE", make_fixnum(PAGESIZE)); |
make_si_constant("LISP-PAGESIZE", make_fixnum(PAGESIZE)); |
894 |
|
|
895 |
|
|
896 |
{object features; |
{object features; |
897 |
|
|
898 |
#define ADD_FEATURE(name) \ |
#define ADD_FEATURE(name) \ |
899 |
features= make_cons(make_ordinary(name),features) |
features= make_cons(make_ordinary(name),features) |
900 |
|
|
901 |
features= make_cons(make_ordinary("COMMON"), |
features= make_cons(make_ordinary("COMMON"), |
902 |
make_cons(make_ordinary("KCL"), Cnil)); |
make_cons(make_ordinary("KCL"), Cnil)); |
903 |
ADD_FEATURE("AKCL"); |
ADD_FEATURE("AKCL"); |
904 |
ADD_FEATURE("GCL"); |
ADD_FEATURE("GCL"); |
905 |
#ifdef BROKEN_O4_OPT |
#ifdef BROKEN_O4_OPT |
906 |
ADD_FEATURE("BROKEN_O4_OPT"); |
ADD_FEATURE("BROKEN_O4_OPT"); |
907 |
#endif |
#endif |
908 |
#ifdef GMP |
#ifdef GMP |
909 |
ADD_FEATURE("GMP"); |
ADD_FEATURE("GMP"); |
910 |
#endif |
#endif |
911 |
|
|
912 |
#ifdef UNIX |
#ifdef UNIX |
913 |
#ifndef WINDOWSNT |
#ifndef WINDOWSNT |
914 |
ADD_FEATURE("UNIX"); |
ADD_FEATURE("UNIX"); |
915 |
#endif |
#endif |
916 |
#endif |
#endif |
917 |
#ifdef IEEEFLOAT |
#ifdef IEEEFLOAT |
918 |
ADD_FEATURE("IEEE-FLOATING-POINT"); |
ADD_FEATURE("IEEE-FLOATING-POINT"); |
919 |
#endif |
#endif |
920 |
#ifdef SGC |
#ifdef SGC |
921 |
ADD_FEATURE("SGC"); |
ADD_FEATURE("SGC"); |
922 |
#endif |
#endif |
923 |
#ifdef ADDITIONAL_FEATURES |
#ifdef ADDITIONAL_FEATURES |
924 |
ADDITIONAL_FEATURES; |
ADDITIONAL_FEATURES; |
925 |
#endif |
#endif |
926 |
#ifdef BSD |
#ifdef BSD |
927 |
ADD_FEATURE("BSD"); |
ADD_FEATURE("BSD"); |
928 |
#endif |
#endif |
929 |
|
|
930 |
#ifdef LITTLE_END |
#ifdef LITTLE_END |
931 |
ADD_FEATURE("CLX-LITTLE-ENDIAN"); |
ADD_FEATURE("CLX-LITTLE-ENDIAN"); |
932 |
#endif |
#endif |
933 |
|
|
934 |
#ifndef PECULIAR_MACHINE |
#ifndef PECULIAR_MACHINE |
935 |
#define BIGM (int)((((unsigned int)(-1))/2)) |
#define BIGM (int)((((unsigned int)(-1))/2)) |
936 |
{ |
{ |
937 |
int ONEM = -1; |
/* int ONEM = -1; */ |
938 |
int Bigm = BIGM; |
int Bigm = BIGM; |
939 |
int Smallm = -BIGM-1; |
int Smallm = -BIGM-1; |
940 |
int Seven = 7; |
int Seven = 7; |
941 |
int Three = 3; |
int Three = 3; |
942 |
if ( (Smallm / Seven) < 0 |
if ( (Smallm / Seven) < 0 |
943 |
&& (Smallm / (-Seven)) > 0 |
&& (Smallm / (-Seven)) > 0 |
944 |
&& (Bigm / (-Seven)) < 0 |
&& (Bigm / (-Seven)) < 0 |
945 |
&& ((-Seven) / Three) == -2 |
&& ((-Seven) / Three) == -2 |
946 |
&& (Seven / (-Three)) == -2 |
&& (Seven / (-Three)) == -2 |
947 |
&& ((-Seven)/ (-Three)) == 2) |
&& ((-Seven)/ (-Three)) == 2) |
948 |
{ ADD_FEATURE("TRUNCATE_USE_C"); |
{ ADD_FEATURE("TRUNCATE_USE_C"); |
949 |
} } |
} } |
950 |
#endif |
#endif |
951 |
|
|
952 |
|
|
953 |
|
|
954 |
make_special("*FEATURES*",features);} |
make_special("*FEATURES*",features);} |
955 |
|
|
956 |
make_si_function("SAVE-SYSTEM", siLsave_system); |
make_si_function("SAVE-SYSTEM", siLsave_system); |
957 |
make_si_sfun("CATCH-FATAL",siLcatch_fatal,ARGTYPE1(f_fixnum)); |
make_si_sfun("CATCH-FATAL",siLcatch_fatal,ARGTYPE1(f_fixnum)); |
958 |
|
|
959 |
} |
} |