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