1 /*  driver.c                            Copyright (C) 2010 Codemist Ltd */
2 
3 
4 /**************************************************************************
5  * Copyright (C) 2010, Codemist Ltd.                     A C Norman       *
6  *                                                                        *
7  * Redistribution and use in source and binary forms, with or without     *
8  * modification, are permitted provided that the following conditions are *
9  * met:                                                                   *
10  *                                                                        *
11  *     * Redistributions of source code must retain the relevant          *
12  *       copyright notice, this list of conditions and the following      *
13  *       disclaimer.                                                      *
14  *     * Redistributions in binary form must reproduce the above          *
15  *       copyright notice, this list of conditions and the following      *
16  *       disclaimer in the documentation and/or other materials provided  *
17  *       with the distribution.                                           *
18  *                                                                        *
19  * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS    *
20  * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT      *
21  * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS      *
22  * FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE         *
23  * COPYRIGHT OWNERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,   *
24  * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,   *
25  * BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS  *
26  * OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND *
27  * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR  *
28  * TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF     *
29  * THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH   *
30  * DAMAGE.                                                                *
31  *************************************************************************/
32 
33 
34 
35 /* Signature: 1cc87404 22-Aug-2010 */
36 
37 /*
38  * This is code that starts up Reduce and exercises it using a
39  * procedurtal rather than textual interface.
40  */
41 
42 #include <stdio.h>
43 #include <setjmp.h>
44 #include <string.h>
45 #include <stdint.h>
46 
47 #include "proc.h"
48 
49 
50 static char ibuff[100], obuff[10000];
51 static int ibufp = 0, obufp = 0;
52 
iget(void)53 static int iget(void)
54 {
55     int c = ibuff[ibufp];
56     if (c == 0) return EOF;
57     ibufp++;
58     return c;
59 }
60 
iput(int c)61 static int iput(int c)
62 {
63     if (obufp < sizeof(obuff)-1)
64     {   obuff[obufp++] = c;
65         obuff[obufp] = 0;
66     }
67     return 0;
68 }
69 
70 
display(PROC_handle p)71 static void display(PROC_handle p)
72 {
73     int ch;
74     if (PROC_atom(p))
75     {   if (PROC_null(p))
76         {   printf("<null>");
77         }
78         else if (PROC_symbol(p))
79         {   printf("%s", PROC_symbol_name(p));
80         }
81         else if (PROC_fixnum(p))
82         {   printf("%d", PROC_integer_value(p));
83         }
84         else printf("<Unknown:%p>", p);
85         return;
86     }
87     ch = '(';
88     while (!PROC_atom(p))
89     {   putchar(ch);
90         ch = ' ';
91         display(PROC_first(p));
92         p = PROC_rest(p);
93     }
94     if (!PROC_null(p))
95     {   printf(" . ");
96         display(p);
97     }
98     putchar(')');
99     return;
100 }
101 
102 
103 /*
104  * I check return codes and if one of the calls into Reduce reports
105  * trouble I pass the code back with the line number on which it was
106  * provoked packed in. You may have some better idea about what to do
107  * with any failures.
108  */
109 
110 #define E(x) if (rc=(x)) return (rc*1000000 + __LINE__)
111 
testcase()112 int testcase()
113 {
114     PROC_handle p;
115     int rc;
116 /*
117  * I enable GC messages here because I want there to be something
118  * sent back via the writer callback. Most people would probably
119  * explicitly switch gc messages off here!
120  */
121     E(PROC_gc_messages(7));      /* Messages from garbage collector etc */
122     E(PROC_set_switch("int", 0));/* Running in "batch" mode, so do not even
123                                   * attempt to make any interactive queries
124                                   * about anything.
125                                   */
126     E(PROC_load_package("int")); /* "int" would in fact autoload, but this
127                                   * demonstrates how to load it manually.
128                                   */
129 
130     E(PROC_clear_stack());
131 
132     E(PROC_push_small_integer(1));               /* 1 */
133     E(PROC_push_symbol("x"));                    /* x */
134     E(PROC_push_small_integer(6));               /* 6 */
135     E(PROC_make_function_call("expt",2));        /* x^6 */
136     E(PROC_push_small_integer(1));               /* 1 */
137     E(PROC_make_function_call("difference",2));  /* x^6-1 */
138     E(PROC_make_function_call("quotient",2));    /* 1/(x^6-1) */
139 
140     E(PROC_push_symbol("x"));
141     E(PROC_make_function_call("int",2));
142 
143     E(PROC_simplify());
144 
145     E(PROC_dup());
146     E(PROC_save(1)); /* note that SAVE pops the item off the stack */
147 
148     E(PROC_make_printable());
149     p = PROC_get_value();
150     display(p);
151 
152     E(PROC_load(1));
153     E(PROC_push_symbol("x"));
154     E(PROC_make_function_call("df",2));  /* To differentiate it */
155     E(PROC_simplify());
156     E(PROC_make_printable());
157     display(PROC_get_value());           /* with luck this is 1/(x^6-1) */
158     return 0;
159 }
160 
161 extern const char *programDir;
162 
submain(int argc,char * argv[])163 static int submain(int argc, char *argv[])
164 {
165     char imageName[256], *nargv[5];
166     int rc;
167 
168     sprintf(imageName, "%s/reduce.img", programDir);
169     nargv[0] = argv[0];
170     nargv[1] = "-i";
171     nargv[2] = imageName;
172     nargv[3] = "-v";
173     nargv[4] = NULL;
174     obufp = 0;
175     cslstart(4, nargv, iput);
176     printf("\nBuffered output is <%s>\n\n", obuff);
177 
178     strcpy(ibuff, "(print '(a b c d))");
179     execute_lisp_function("oem-supervisor", iget, iput);
180     printf("\nBuffered output is <%s>\n\n", obuff);
181 
182     ibufp = obufp = 0;
183     ibuff[0] = 0;
184     PROC_set_callbacks(iget, iput);
185 
186     if ((rc = testcase()) != 0) printf("Return code = %d\n", rc);
187 
188     rc = cslfinish(iput);
189     printf("\nBuffered output is <%s>\n\n", obuff);
190 
191     my_exit(rc);   /* does a longjmp on exit_buffer */
192     return 0;
193 }
194 
195 
main(int argc,char * argv[])196 int main(int argc, char *argv[])
197 {
198     int res;
199     if (find_program_directory(argv[0]))
200     {   fprintf(stderr, "Unable to identify program name and directory\n");
201         return 1;
202     }
203 
204     if (!setjmp(my_exit_buffer)) res = submain(argc, argv);
205     else res = my_return_code;
206     printf("Return code = %d\n", res);
207     return res;
208 }
209 
210 
211 /* End of driver.c */
212 
213