maple_interface.c 3.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132
  1. /*
  2. * Code to assist in making CSL startable from within Maple. This
  3. * version of the code is customised to assist with the "tay" package...
  4. * but variations on this code to support interfacing from Maple to
  5. * REDUCE or other Lisp packages could follow the same pattern.
  6. */
  7. #include <stdio.h>
  8. #include <stdarg.h>
  9. /* Signature: 0def4e10 27-Sep-2001 */
  10. /*
  11. * As of 17 Sept 2001 when I try to build a DLL for CSL for use with
  12. * Maple I find a moan about atexit() being undefined. Since I do not
  13. * really need a working version of it when CSL is called as a foreign
  14. * function I find the easiest fix is to provide the dummy version here.
  15. * But when the underlying issue is resolved this silly definition will
  16. * need to be removed again.
  17. */
  18. int atexit(void (*fn)())
  19. {
  20. }
  21. /*
  22. * The sizes of the buffers here are arbitrary and a trap for
  23. * the over-enthusiastic!
  24. */
  25. static char ibuff[1000], obuff[100000];
  26. static int ibufp = 0, obufp = 0;
  27. static int iget()
  28. {
  29. int c = ibuff[ibufp++];
  30. if (c == 0) return EOF;
  31. else return c;
  32. }
  33. static int iput(int c)
  34. {
  35. if (obufp < sizeof(obuff)-1)
  36. { obuff[obufp++] = c;
  37. obuff[obufp] = 0;
  38. }
  39. return 0;
  40. }
  41. void start_csl()
  42. {
  43. char *argv[5];
  44. int argc = 0;
  45. argv[argc++] = "/scl/people/guests/norman/rtaylor/tay";
  46. argv[argc++] = "-v";
  47. argv[argc++] = "--";
  48. argv[argc++] = "/scl/people/guests/norman/rtaylor/tay.out";
  49. obufp = 0;
  50. cslstart(argc, argv, iput);
  51. fprintf(stderr, "%s\n", obuff);
  52. }
  53. #include "machine.h"
  54. #include "tags.h"
  55. #include "externs.h"
  56. #include "stream.h"
  57. #include "entries.h"
  58. int execute_lisp_function(char *fname,
  59. character_reader *r, character_writer *w)
  60. {
  61. Lisp_Object nil;
  62. Lisp_Object ff = make_undefined_symbol(fname);
  63. nil = C_nil;
  64. if (exception_pending()) return 1; /* Failed to make the symbol */
  65. procedural_input = r;
  66. procedural_output = w;
  67. Lapply0(nil, ff);
  68. procedural_input = NULL;
  69. procedural_output = NULL;
  70. nil = C_nil;
  71. if (exception_pending()) return 2; /* Failure during evaluation */
  72. return 0;
  73. }
  74. void use_csl(char *s)
  75. {
  76. fprintf(stderr, "calling CSL : <%s>\n", s);
  77. if (strlen(s) >= sizeof(ibuff))
  78. { fprintf(stderr, "Input string is too long\n");
  79. return;
  80. }
  81. strcpy(ibuff, s);
  82. ibufp = obufp = 0;
  83. execute_lisp_function("read_tay", iget, NULL /*iput*/);
  84. /* fprintf(stderr, "%s\n", obuff); */
  85. }
  86. int execute_lisp_function1(char *fname, Lisp_Object arg,
  87. character_reader *r, character_writer *w)
  88. {
  89. Lisp_Object nil;
  90. Lisp_Object ff = make_undefined_symbol(fname);
  91. nil = C_nil;
  92. if (exception_pending()) return 1; /* Failed to make the symbol */
  93. procedural_input = r;
  94. procedural_output = w;
  95. Lapply1(nil, ff, arg);
  96. procedural_input = NULL;
  97. procedural_output = NULL;
  98. nil = C_nil;
  99. if (exception_pending()) return 2; /* Failure during evaluation */
  100. return 0;
  101. }
  102. void use_csl1(unsigned int s)
  103. {
  104. ibufp = obufp = 0;
  105. execute_lisp_function1("maple_tay", encapsulate_pointer((void *)s),
  106. iget, iput);
  107. fprintf(stderr, "%s\n", obuff);
  108. fflush(stderr);
  109. }
  110. /* end of maple_interface.c */