/[gcl]/gcl/o/main.c
ViewVC logotype

Diff of /gcl/o/main.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.12 by camm, Fri Jul 12 22:00:49 2002 UTC revision 1.13 by camm, Sat Jul 20 07:10:55 2002 UTC
# Line 24  Foundation, 675 Mass Ave, Cambridge, MA Line 24  Foundation, 675 Mass Ave, Cambridge, MA
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
# Line 96  unsigned int _stacktop, _stackbottom; Line 97  unsigned int _stacktop, _stackbottom;
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
# Line 107  void install_segmentation_catcher(); Line 108  void install_segmentation_catcher();
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);
# Line 258  char **argv, **envp; Line 252  char **argv, **envp;
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                    
# Line 339  char **argv, **envp; Line 341  char **argv, **envp;
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;
# Line 355  void install_segmentation_catcher() Line 359  void 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;
# Line 372  char *s; Line 375  char *s;
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
# Line 515  initlisp() Line 518  initlisp()
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");
# Line 533  bds_overflow() Line 536  bds_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");
# Line 542  frs_overflow() Line 545  frs_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");
# Line 552  ihs_overflow() Line 555  ihs_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");
# Line 579  cs_overflow() Line 581  cs_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;
# Line 599  va_dcl Line 601  va_dcl
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) \
# Line 734  int arg; Line 745  int arg;
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
# Line 806  DEFUNO("LISP-IMPLEMENTATION-VERSION",obj Line 809  DEFUNO("LISP-IMPLEMENTATION-VERSION",obj
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),"");
# Line 866  DEFVAR("*MULTIPLY-STACKS*",sSAmultiply_s Line 869  DEFVAR("*MULTIPLY-STACKS*",sSAmultiply_s
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  }  }

Legend:
Removed from v.1.12  
changed lines
  Added in v.1.13

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26