28 |
#include <unistd.h> |
#include <unistd.h> |
29 |
#include <string.h> |
#include <string.h> |
30 |
|
|
31 |
|
static void |
32 |
|
init_main(void); |
33 |
|
|
34 |
|
static void |
35 |
|
initlisp(void); |
36 |
|
|
37 |
|
static int |
38 |
|
multiply_stacks(int); |
39 |
|
|
40 |
#define IN_MAIN |
#define IN_MAIN |
41 |
|
|
42 |
#ifdef KCLOVM |
#ifdef KCLOVM |
383 |
#endif |
#endif |
384 |
} |
} |
385 |
|
|
386 |
void |
static void |
387 |
initlisp(void) { |
initlisp(void) { |
388 |
|
|
389 |
int j; |
int j; |
588 |
error("Segmentation violation."); |
error("Segmentation violation."); |
589 |
} |
} |
590 |
|
|
591 |
void |
/* static void */ |
592 |
cs_overflow(void) { |
/* cs_overflow(void) { */ |
593 |
#ifdef AV |
/* #ifdef AV */ |
594 |
if (cs_limit < cs_org - cssize) |
/* if (cs_limit < cs_org - cssize) */ |
595 |
error("control stack overflow"); |
/* error("control stack overflow"); */ |
596 |
cs_limit -= CSGETA; |
/* cs_limit -= CSGETA; */ |
597 |
#endif |
/* #endif */ |
598 |
#ifdef MV |
/* #ifdef MV */ |
|
|
|
599 |
|
|
600 |
|
|
|
#endif |
|
|
FEerror("Control stack overflow.", 0); |
|
|
} |
|
601 |
|
|
602 |
void |
/* #endif */ |
603 |
end_of_file(void) { |
/* FEerror("Control stack overflow.", 0); */ |
604 |
error("end of file"); |
/* } */ |
605 |
} |
|
606 |
|
/* static void */ |
607 |
|
/* end_of_file(void) { */ |
608 |
|
/* error("end of file"); */ |
609 |
|
/* } */ |
610 |
|
|
611 |
DEFUNO_NEW("BYE",object,fLbye,LISP |
DEFUNO_NEW("BYE",object,fLbye,LISP |
612 |
,0,1,NONE,OI,OO,OO,OO,Lby,(int exitc),"") |
,0,1,NONE,OI,OO,OO,OO,void,Lby,(int exitc),"") |
613 |
{ int n=VFUN_NARGS; |
{ int n=VFUN_NARGS; |
614 |
int exit_code; |
int exit_code; |
615 |
if (n>=1) exit_code=exitc;else exit_code=0; |
if (n>=1) exit_code=exitc;else exit_code=0; |
623 |
|
|
624 |
} |
} |
625 |
|
|
626 |
DEFUNO_NEW("QUIT",object,fLquit,LISP |
DEFUN_NEW("QUIT",object,fLquit,LISP |
627 |
,0,1,NONE,OI,OO,OO,OO,Lquit,(int exitc),"") |
,0,1,NONE,OI,OO,OO,OO,(int exitc),"") |
628 |
{ return fLbye(exitc); } |
{ return fLbye(exitc); } |
629 |
|
|
630 |
DEFUNO_NEW("EXIT",object,fLexit,LISP |
DEFUN_NEW("EXIT",object,fLexit,LISP |
631 |
,0,1,NONE,OI,OO,OO,OO,Lexit,(int exitc),"") |
,0,1,NONE,OI,OO,OO,OO,(int exitc),"") |
632 |
{ return fLbye(exitc); } |
{ return fLbye(exitc); } |
633 |
|
|
634 |
|
|
639 |
/* #endif */ |
/* #endif */ |
640 |
/* } */ |
/* } */ |
641 |
|
|
642 |
void |
static void |
643 |
siLargc(void) { |
siLargc(void) { |
644 |
check_arg(0); |
check_arg(0); |
645 |
vs_push(make_fixnum(ARGC)); |
vs_push(make_fixnum(ARGC)); |
646 |
} |
} |
647 |
|
|
648 |
void |
static void |
649 |
siLargv(void) { |
siLargv(void) { |
650 |
int i=0; |
int i=0; |
651 |
|
|
659 |
} |
} |
660 |
|
|
661 |
#ifdef UNIX |
#ifdef UNIX |
662 |
void |
static void |
663 |
siLgetenv(void) { |
siLgetenv(void) { |
664 |
|
|
665 |
char name[256]; |
char name[256]; |
689 |
|
|
690 |
object *vs_marker; |
object *vs_marker; |
691 |
|
|
692 |
void |
static void |
693 |
siLmark_vs(void) { |
siLmark_vs(void) { |
694 |
check_arg(0); |
check_arg(0); |
695 |
vs_marker = vs_base; |
vs_marker = vs_base; |
696 |
vs_base[0] = Cnil; |
vs_base[0] = Cnil; |
697 |
} |
} |
698 |
|
|
699 |
void |
static void |
700 |
siLcheck_vs(void) { |
siLcheck_vs(void) { |
701 |
check_arg(0); |
check_arg(0); |
702 |
if (vs_base != vs_marker) |
if (vs_base != vs_marker) |
704 |
vs_base[0] = Cnil; |
vs_base[0] = Cnil; |
705 |
} |
} |
706 |
|
|
707 |
object |
static object |
708 |
siLcatch_fatal(int i) { |
siLcatch_fatal(int i) { |
709 |
catch_fatal=i; |
catch_fatal=i; |
710 |
return Cnil; |
return Cnil; |
759 |
lim = ((typ *)p) - (STACK_OVER+1)*geta; \ |
lim = ((typ *)p) - (STACK_OVER+1)*geta; \ |
760 |
}while (0) |
}while (0) |
761 |
|
|
762 |
int |
static int |
763 |
multiply_stacks(int m) { |
multiply_stacks(int m) { |
764 |
/* int n; */ |
/* int n; */ |
765 |
/* object x; */ |
/* object x; */ |
794 |
vs_base[0] = Cnil; |
vs_base[0] = Cnil; |
795 |
} |
} |
796 |
|
|
797 |
void |
static void |
798 |
siLuser_init(void) { |
siLuser_init(void) { |
799 |
check_arg(0); |
check_arg(0); |
800 |
sLApackageA->s.s_dbind = user_package; |
sLApackageA->s.s_dbind = user_package; |
802 |
vs_base[0] = Cnil; |
vs_base[0] = Cnil; |
803 |
} |
} |
804 |
|
|
805 |
void |
static void |
806 |
siLaddress(void) { |
siLaddress(void) { |
807 |
check_arg(1); |
check_arg(1); |
808 |
vs_base[0] = make_fixnum((long)vs_base[0]); |
vs_base[0] = make_fixnum((long)vs_base[0]); |
809 |
} |
} |
810 |
|
|
811 |
void |
static void |
812 |
siLnani(void) { |
siLnani(void) { |
813 |
check_arg(1); |
check_arg(1); |
814 |
vs_base[0] = (object)fixint(vs_base[0]); |
vs_base[0] = (object)fixint(vs_base[0]); |
815 |
} |
} |
816 |
|
|
817 |
void |
static void |
818 |
siLinitialization_failure(void) { |
siLinitialization_failure(void) { |
819 |
check_arg(0); |
check_arg(0); |
820 |
printf("lisp initialization failed\n"); |
printf("lisp initialization failed\n"); |
822 |
} |
} |
823 |
|
|
824 |
DEFUNO_NEW("IDENTITY",object,fLidentity,LISP |
DEFUNO_NEW("IDENTITY",object,fLidentity,LISP |
825 |
,1,1,NONE,OO,OO,OO,OO,Lidentity,(object x0),"") |
,1,1,NONE,OO,OO,OO,OO,void,Lidentity,(object x0),"") |
826 |
{ |
{ |
827 |
/* 1 args */ |
/* 1 args */ |
828 |
RETURN1 (x0); |
RETURN1 (x0); |
829 |
} |
} |
830 |
|
|
831 |
DEFUNO_NEW("LISP-IMPLEMENTATION-VERSION",object,fLlisp_implementation_version,LISP |
DEFUN_NEW("LISP-IMPLEMENTATION-VERSION",object,fLlisp_implementation_version,LISP |
832 |
,0,0,NONE,OO,OO,OO,OO,Llisp_implementation_version,(void),"") |
,0,0,NONE,OO,OO,OO,OO,(void),"") |
833 |
{ |
{ |
834 |
/* 0 args */ |
/* 0 args */ |
835 |
RETURN1((make_simple_string(LISP_IMPLEMENTATION_VERSION))); |
RETURN1((make_simple_string(LISP_IMPLEMENTATION_VERSION))); |
836 |
} |
} |
837 |
|
|
838 |
|
|
839 |
void |
static void |
840 |
siLsave_system(void) { |
siLsave_system(void) { |
841 |
int i; |
int i; |
842 |
|
|
892 |
DEF_ORDINARY("TOP-LEVEL",sStop_level,SI,""); |
DEF_ORDINARY("TOP-LEVEL",sStop_level,SI,""); |
893 |
DEFVAR("*COMMAND-ARGS*",sSAcommand_argsA,SI,sLnil,""); |
DEFVAR("*COMMAND-ARGS*",sSAcommand_argsA,SI,sLnil,""); |
894 |
|
|
895 |
void |
static void |
896 |
init_main(void) { |
init_main(void) { |
897 |
|
|
898 |
make_function("BY", Lby); |
make_function("BY", Lby); |