home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / siod / siod_v29.lha / siod.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-08-16  |  1.8 KB  |  96 lines
  1. /* Scheme In One Defun, but in C this time.
  2.  
  3.  *                    COPYRIGHT (c) 1988-1992 BY                            *
  4.  *        PARADIGM ASSOCIATES INCORPORATED, CAMBRIDGE, MASSACHUSETTS.       *
  5.  *        See the source file SLIB.C for more information.                  *
  6.  
  7. */
  8.  
  9. /*
  10.  
  11. gjc@paradigm.com
  12.  
  13. Paradigm Associates Inc          Phone: 617-492-6079
  14. 29 Putnam Ave, Suite 6
  15. Cambridge, MA 02138
  16.  
  17. An example main-program call with some customized subrs.
  18.  
  19.   */
  20.  
  21. #include <stdio.h>
  22. #ifdef THINK_C
  23. #include <console.h>
  24. #endif
  25.  
  26. #include "siod.h"
  27.  
  28. LISP my_one;
  29. LISP my_two;
  30.  
  31. LISP cfib(LISP x);
  32.  
  33. #ifdef VMS
  34. LISP vms_debug(LISP cmd);
  35. #endif
  36.  
  37. int main(int argc,char **argv)
  38. {print_welcome();
  39. #ifdef THINK_C
  40.  argc = ccommand(&argv);
  41. #endif
  42.  process_cla(argc,argv,1);
  43.  print_hs_1();
  44.  init_storage();
  45.  init_subrs();
  46.  init_trace();
  47.  my_one = flocons((double) 1.0);
  48.  my_two = flocons((double) 2.0);
  49.  gc_protect(&my_one);
  50.  gc_protect(&my_two);
  51.  init_subr("cfib",tc_subr_1,cfib);
  52. #ifdef VMS
  53.  init_subr("vms-debug",tc_subr_1,vms_debug);
  54. #endif
  55.  repl_driver(1,1);
  56.  printf("EXIT\n");}
  57.  
  58. /* This is cfib, (compiled fib). Test to see what the overhead
  59.    of interpretation actually is in a given implementation benchmark
  60.    standard-fib against cfib.
  61.  
  62.    (define (standard-fib x)
  63.      (if (< x 2)
  64.          x
  65.          (+ (standard-fib (- x 1))
  66.         (standard-fib (- x 2)))))  
  67.  
  68. */
  69.  
  70. LISP cfib(LISP x)
  71. {if NNULLP(lessp(x,my_two))
  72.    return(x);
  73.  else
  74.    return(plus(cfib(difference(x,my_one)),
  75.            cfib(difference(x,my_two))));}
  76.  
  77. #ifdef VMS
  78.  
  79. #include <ssdef.h>
  80. #include <descrip.h>
  81.  
  82. LISP vms_debug(arg)
  83.      LISP arg;
  84. {unsigned char arg1[257];
  85.  char *data;
  86.  if NULLP(arg)
  87.    lib$signal(SS$_DEBUG,0);
  88.  else
  89.    {data = get_c_string(arg);
  90.     arg1[0] = strlen(data);
  91.     memcpy(&arg1[1],data,arg1[0]);
  92.     lib$signal(SS$_DEBUG,1,arg1);}
  93.  return(NIL);}
  94.  
  95. #endif
  96.