/[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.33 by camm, Sun Sep 14 02:43:07 2003 UTC revision 1.34 by camm, Thu Nov 6 16:08:09 2003 UTC
# Line 425  initlisp(void) { Line 425  initlisp(void) {
425          export(Ct, common_lisp_package);          export(Ct, common_lisp_package);
426  #endif  #endif
427    
428          sLquote = make_ordinary("QUOTE");  /*      sLquote = make_ordinary("QUOTE"); */
429          sLfunction = make_ordinary("FUNCTION");  /*      sLfunction = make_ordinary("FUNCTION"); */
430          sLlambda = make_ordinary("LAMBDA");          sLlambda = make_ordinary("LAMBDA");
431          sLlambda_block = make_ordinary("LAMBDA-BLOCK");          sLlambda_block = make_ordinary("LAMBDA-BLOCK");
432          sLlambda_closure = make_ordinary("LAMBDA-CLOSURE");          sLlambda_closure = make_ordinary("LAMBDA-CLOSURE");
# Line 506  initlisp(void) { Line 506  initlisp(void) {
506          gcl_init_links();          gcl_init_links();
507    
508          gcl_init_fat_string();          gcl_init_fat_string();
509            gcl_init_sfasl();
510  #ifdef CMAC  #ifdef CMAC
511          gcl_init_cmac();          gcl_init_cmac();
512  #endif    #endif  
# Line 577  DEFUNO_NEW("BYE",object,fLbye,LISP Line 578  DEFUNO_NEW("BYE",object,fLbye,LISP
578    
579  DEFUN_NEW("QUIT",object,fLquit,LISP  DEFUN_NEW("QUIT",object,fLquit,LISP
580         ,0,1,NONE,OI,OO,OO,OO,(fixnum exitc),"")         ,0,1,NONE,OI,OO,OO,OO,(fixnum exitc),"")
581  {       return fLbye(exitc); }  {       return FFN(fLbye)(exitc); }
582    
583  /* DEFUN_NEW("EXIT",object,fLexit,LISP */  /* DEFUN_NEW("EXIT",object,fLexit,LISP */
584  /*        ,0,1,NONE,OI,OO,OO,OO,(fixnum exitc),"") */  /*        ,0,1,NONE,OI,OO,OO,OO,(fixnum exitc),"") */
# Line 585  DEFUN_NEW("QUIT",object,fLquit,LISP Line 586  DEFUN_NEW("QUIT",object,fLquit,LISP
586    
587    
588  static void  static void
589  siLargc(void) {  FFN(siLargc)(void) {
590    check_arg(0);    check_arg(0);
591    vs_push(make_fixnum(ARGC));    vs_push(make_fixnum(ARGC));
592  }  }
593    
594  static void  static void
595  siLargv(void) {  FFN(siLargv)(void) {
596    int i=0;    int i=0;
597        
598    check_arg(1);    check_arg(1);
# Line 605  siLargv(void) { Line 606  siLargv(void) {
606    
607  #ifdef UNIX  #ifdef UNIX
608  static void  static void
609  siLgetenv(void) {  FFN(siLgetenv)(void) {
610    
611    char name[256];    char name[256];
612    int i;    int i;
# Line 634  siLgetenv(void) { Line 635  siLgetenv(void) {
635  object *vs_marker;  object *vs_marker;
636    
637  static void  static void
638  siLmark_vs(void) {  FFN(siLmark_vs)(void) {
639    check_arg(0);    check_arg(0);
640    vs_marker = vs_base;    vs_marker = vs_base;
641    vs_base[0] = Cnil;    vs_base[0] = Cnil;
642  }  }
643    
644  static void  static void
645  siLcheck_vs(void) {  FFN(siLcheck_vs)(void) {
646    check_arg(0);    check_arg(0);
647    if (vs_base != vs_marker)    if (vs_base != vs_marker)
648      FEerror("Value stack is flawed.", 0);      FEerror("Value stack is flawed.", 0);
# Line 649  siLcheck_vs(void) { Line 650  siLcheck_vs(void) {
650  }  }
651    
652  static object  static object
653  siLcatch_fatal(int i) {  FFN(siLcatch_fatal)(int i) {
654    catch_fatal=i;    catch_fatal=i;
655    return Cnil;    return Cnil;
656  }  }
# Line 664  reset_cstack_limit(int arg) { Line 665  reset_cstack_limit(int arg) {
665  #endif  #endif
666  }  }
667    
668  void  LFD(siLreset_stack_limits)(void)
 siLreset_stack_limits(void)  
669  {  {
670    int i=0;    int i=0;
671    
# Line 731  multiply_stacks(int m) { Line 731  multiply_stacks(int m) {
731    
732  DEFVAR("*NO-INIT*",sSAno_initA,SI,Cnil,"");  DEFVAR("*NO-INIT*",sSAno_initA,SI,Cnil,"");
733    
734  void  LFD(siLinit_system)(void) {
 siLinit_system(void) {  
735    check_arg(0);    check_arg(0);
736    gcl_init_system(sSAno_initA);    gcl_init_system(sSAno_initA);
737    vs_base[0] = Cnil;    vs_base[0] = Cnil;
738  }  }
739    
740  static void  static void
741  siLuser_init(void) {  FFN(siLuser_init)(void) {
742    check_arg(0);    check_arg(0);
743    sLApackageA->s.s_dbind = user_package;    sLApackageA->s.s_dbind = user_package;
744    user_init();    user_init();
# Line 747  siLuser_init(void) { Line 746  siLuser_init(void) {
746  }  }
747    
748  static void  static void
749  siLaddress(void) {  FFN(siLaddress)(void) {
750    check_arg(1);    check_arg(1);
751    vs_base[0] = make_fixnum((long)vs_base[0]);    vs_base[0] = make_fixnum((long)vs_base[0]);
752  }  }
753    
754  static void  static void
755  siLnani(void) {  FFN(siLnani)(void) {
756    check_arg(1);    check_arg(1);
757    vs_base[0] = (object)fixint(vs_base[0]);    vs_base[0] = (object)fixint(vs_base[0]);
758  }  }
759    
760  static void  static void
761  siLinitialization_failure(void) {  FFN(siLinitialization_failure)(void) {
762    check_arg(0);    check_arg(0);
763    printf("lisp initialization failed\n");    printf("lisp initialization failed\n");
764    exit(0);    exit(0);
# Line 781  DEFUN_NEW("LISP-IMPLEMENTATION-VERSION", Line 780  DEFUN_NEW("LISP-IMPLEMENTATION-VERSION",
780    
781    
782  static void  static void
783  siLsave_system(void) {  FFN(siLsave_system)(void) {
784    int i;    int i;
785        
786  #ifdef HAVE_YP_UNBIND  #ifdef HAVE_YP_UNBIND
# Line 925  init_main(void) { Line 924  init_main(void) {
924        
925    make_si_function("SAVE-SYSTEM", siLsave_system);    make_si_function("SAVE-SYSTEM", siLsave_system);
926    make_si_sfun("CATCH-FATAL",siLcatch_fatal,ARGTYPE1(f_fixnum));    make_si_sfun("CATCH-FATAL",siLcatch_fatal,ARGTYPE1(f_fixnum));
927      make_si_function("WARN-VERSION",Lidentity);
928        
929  }  }

Legend:
Removed from v.1.33  
changed lines
  Added in v.1.34

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