annotate keiko/xmain.c @ 1:b5139af1a420 tip basis

Fixed permissions on compile scripts
author Mike Spivey <mike@cs.ox.ac.uk>
date Fri, 13 Oct 2017 17:27:58 +0100
parents bfdcc3820b32
children
rev   line source
0
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
1 /*
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
2 * xmain.c
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
3 *
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
4 * This file is part of the Oxford Oberon-2 compiler
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
5 * Copyright (c) 2006--2016 J. M. Spivey
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
6 * All rights reserved
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
7 *
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
8 * Redistribution and use in source and binary forms, with or without
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
9 * modification, are permitted provided that the following conditions are met:
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
10 *
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
11 * 1. Redistributions of source code must retain the above copyright notice,
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
12 * this list of conditions and the following disclaimer.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
13 * 2. Redistributions in binary form must reproduce the above copyright notice,
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
14 * this list of conditions and the following disclaimer in the documentation
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
15 * and/or other materials provided with the distribution.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
16 * 3. The name of the author may not be used to endorse or promote products
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
17 * derived from this software without specific prior written permission.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
18 *
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
19 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
20 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
21 * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
22 * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
23 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
24 * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
25 * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
26 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
27 * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
28 * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
29 */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
30
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
31 #define EXTERN
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
32 #include "obx.h"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
33 #include "keiko.h"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
34 #include "exec.h"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
35
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
36 #ifdef JIT
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
37 #include "vm.h"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
38 #ifdef DEBUG
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
39 #define JTEST 1
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
40 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
41 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
42
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
43 #ifdef PROFILE
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
44 #define MYNAME "profiler"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
45 #else
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
46 #ifdef OBXDEB
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
47 #define MYNAME "debugging monitor"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
48 #else
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
49 #define MYNAME "runtime system"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
50 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
51 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
52
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
53 const char *version =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
54 "Oxford Oberon-2 " MYNAME " version " PACKAGE_VERSION " [build " REVID "]"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
55 #ifdef JIT
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
56 " (JIT)"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
57 #else
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
58 ""
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
59 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
60 #ifdef DEBUG
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
61 " (debug)"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
62 #else
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
63 ""
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
64 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
65 ;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
66 const char *copyright = "Copyright (C) 1999--2012 J. M. Spivey";
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
67
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
68 extern int vm_debug;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
69
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
70 /* Helper functions for the loader */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
71
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
72 module make_module(char *name, uchar *addr, int chksum, int nlines) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
73 module m = (module) scratch_alloc(sizeof(struct _module));
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
74 m->m_name = name;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
75 m->m_addr = addr;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
76 #ifdef PROFILE
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
77 m->m_nlines = nlines;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
78 m->m_lcount = NULL;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
79 if (lflag && nlines > 0) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
80 m->m_lcount =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
81 (unsigned *) scratch_alloc(nlines * sizeof(unsigned));
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
82 memset(m->m_lcount, 0, nlines * sizeof(int));
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
83 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
84 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
85 #ifdef OBXDEB
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
86 debug_message("module %s %#x", name, chksum);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
87 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
88 return m;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
89 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
90
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
91 proc make_proc(char *name, uchar *addr) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
92 proc p = (proc) scratch_alloc(sizeof(struct _proc));
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
93 p->p_name = name;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
94 p->p_addr = (value *) addr;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
95 #ifdef PROFILE
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
96 p->p_calls = p->p_rec = p->p_self = p->p_child = 0;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
97 p->p_parents = p->p_children = NULL;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
98 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
99 #ifdef OBXDEB
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
100 debug_message("proc %s %#x %#x %d", name, address(addr),
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
101 p->p_addr[CP_CODE].a, p->p_addr[CP_SIZE].i);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
102 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
103 return p;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
104 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
105
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
106 void make_symbol(const char *kind, char *name, uchar *addr) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
107 #ifdef OBXDEB
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
108 debug_message("%s %s %#x", kind, name, address(addr));
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
109 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
110 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
111
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
112 /* Runtime errors */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
113
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
114 #ifndef OBXDEB
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
115 #define TOP 5 /* Number of frames shown at top and bottom */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
116 #define BOT 5
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
117 #define GAP 10 /* Don't omit less than this many frames */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
118 #define NBUF (BOT+GAP-1)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
119
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
120 static void backtrace(value *bp) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
121 value *fp = bp, *cp = valptr(bp[CP]);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
122 proc p = find_proc(cp);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
123 int n, j;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
124 proc fbuf[NBUF];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
125
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
126 fprintf(stderr, "In procedure %s\n", p->p_name);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
127
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
128 /* Chain down the stack, printing the first TOP frames,
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
129 and saving the last NBUF in a circular buffer. */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
130 for (n = 0;; n++) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
131 /* Each frame contains the cp and bp of its caller */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
132 fp = valptr(fp[BP]); /* Base pointer of next frame */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
133 if (fp == NULL) break;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
134 cp = valptr(fp[CP]); /* Constant pool of next frame */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
135 fbuf[n%NBUF] = p = find_proc(cp);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
136 if (n < TOP)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
137 fprintf(stderr, " called from %s\n", p->p_name);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
138 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
139
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
140 /* Now the last NBUF frames are f(n-NBUF), ..., f(n-1)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
141 where f(i) = fbuf[i%NBUF] -- unless there are fewer
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
142 then NBUF frames in all. */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
143
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
144 if (n < TOP+GAP+BOT)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
145 /* Print the n-TOP frames not printed already */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
146 j = TOP;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
147 else {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
148 /* Omit n-(TOP+BOT) frames (at least GAP) and print the
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
149 last BOT frames */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
150 fprintf(stderr, " ... %d intervening frames omitted ...\n",
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
151 n-(TOP+BOT));
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
152 j = n-BOT;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
153 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
154
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
155 /* Print frames j, ..., n-1 */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
156 for (; j < n; j++)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
157 fprintf(stderr, " called from %s\n", fbuf[j%NBUF]->p_name);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
158 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
159 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
160
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
161 static const char *message(int code) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
162 switch (code) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
163 case E_CAST:
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
164 return "dynamic type error in cast";
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
165 case E_ASSIGN:
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
166 return "dynamic type error in record assignment";
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
167 case E_CASE:
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
168 return "no matching label in CASE statement";
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
169 case E_WITH:
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
170 return "no matching type guard in WITH statement";
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
171 case E_ASSERT:
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
172 return "assertion failed (%d)";
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
173 case E_RETURN:
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
174 return "function failed to return a result";
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
175 case E_BOUND:
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
176 return "array bound error";
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
177 case E_NULL:
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
178 return "null pointer error";
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
179 case E_DIV:
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
180 return "DIV or MOD by zero";
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
181 case E_FDIV:
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
182 return "division by zero";
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
183 case E_STACK:
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
184 return "stack overflow";
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
185 case E_GLOB:
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
186 return "assignment of local procedure";
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
187 default:
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
188 return "the impossible has happened";
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
189 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
190 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
191
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
192 /* error_stop -- runtime error with explicit message text */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
193 void error_stop(const char *msg, int line, value *bp, uchar *pc) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
194 value *cp = valptr(bp[CP]);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
195
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
196 #ifdef OBXDEB
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
197 char buf[256];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
198 sprintf(buf, msg, ob_res.i);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
199 debug_break(cp, bp, pc, "error %d %s", line, buf);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
200 #else
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
201 module mod = find_module(cp);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
202
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
203 fprintf(stderr, "Runtime error: ");
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
204 fprintf(stderr, msg, ob_res.i);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
205 if (line > 0) fprintf(stderr, " on line %d", line);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
206 if (mod != NULL && strcmp(mod->m_name, "_Builtin") != 0)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
207 fprintf(stderr, " in module %s", mod->m_name);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
208 fprintf(stderr, "\n");
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
209 fflush(stderr);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
210
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
211 if (nprocs == 0)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
212 fprintf(stderr, "(No debugging information available)\n");
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
213 else if (bp != NULL)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
214 backtrace(bp);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
215
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
216 fflush(stderr);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
217 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
218
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
219 exit(2);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
220 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
221
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
222 /* runtime_error -- report a runtime error */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
223 void runtime_error(int m, int line, value *bp, uchar *pc) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
224 error_stop(message(m), line, bp, pc);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
225 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
226
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
227 /* rterror -- simple version of runtime_error for JIT */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
228 void rterror(int num, int line, value *bp) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
229 runtime_error(num, line, bp, NULL);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
230 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
231
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
232 /* stkoflo -- stack overflow handler for JIT */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
233 void stkoflo(value *bp) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
234 runtime_error(E_STACK, 0, bp, NULL);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
235 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
236
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
237
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
238 /* Startup */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
239
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
240 static void run(value *prog) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
241 value *sp;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
242
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
243 /* Allow 32-word safety margin (for tracing) */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
244 sp = (value *) (stack + stack_size) - 32;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
245
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
246 sp -= HEAD;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
247 sp[BP].a = address(NULL);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
248 sp[PC].a = address(NULL);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
249 sp[CP].a = address(prog);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
250 primcall(prog, sp);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
251 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
252
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
253 mybool custom_file(char *name) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
254 char buf[4];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
255 FILE *fp;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
256 int nread;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
257 mybool result;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
258
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
259 fp = fopen(name, "rb");
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
260 if (fp == NULL) return FALSE;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
261 fseek(fp, - (long) sizeof(trailer), SEEK_END);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
262 nread = fread(buf, 1, 4, fp);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
263 if (nread < 4 || strncmp(buf, MAGIC, 4) != 0)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
264 result = FALSE;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
265 else {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
266 fseek(fp, 0, SEEK_SET);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
267 nread = fread(buf, 1, 2, fp);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
268 result = (nread == 2 && strncmp(buf, "#!", 2) != 0);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
269 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
270 fclose(fp);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
271 return result;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
272 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
273
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
274 #ifdef WINDOWS
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
275 #include <windows.h>
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
276 #include <winbase.h>
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
277
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
278 char *search_path(char *name) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
279 static char buf[_MAX_PATH];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
280 char *filepart;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
281
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
282 if (SearchPath(NULL, name, ".exe", _MAX_PATH, buf, &filepart) == 0)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
283 return NULL;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
284
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
285 return buf;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
286 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
287 #else
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
288 #include <sys/stat.h>
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
289 #ifdef HAVE_UNISTD_H
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
290 #include <unistd.h>
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
291 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
292
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
293 char *search_path(char *name) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
294 char *path;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
295 static char buf[256];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
296 struct stat stbuf;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
297
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
298 if (name == NULL || strchr(name, '/') != NULL) return name;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
299
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
300 path = getenv("PATH");
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
301 if (path == NULL) return NULL;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
302
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
303 for (char *p = path, *q; p != NULL; p = q) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
304 q = strchr(p, ':');
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
305 char *r;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
306 if (q == NULL) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
307 strcpy(buf, p);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
308 r = buf + strlen(p);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
309 } else {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
310 strncpy(buf, p, q-p);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
311 r = buf + (q-p); q++;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
312 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
313 if (r > buf) *r++ = '/';
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
314 strcpy(r, name);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
315
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
316 if (access(buf, R_OK) == 0 && stat(buf, &stbuf) == 0
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
317 && S_ISREG(stbuf.st_mode))
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
318 return buf;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
319 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
320
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
321 return NULL;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
322 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
323 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
324
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
325 #define argc saved_argc
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
326 #define argv saved_argv
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
327
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
328 static char *progname;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
329 #ifdef PROFILE
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
330 static char *profout;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
331 static const char *dumpname = "obprof.out";
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
332 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
333
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
334 static void usage(void) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
335 #ifdef PROFILE
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
336 fprintf(stderr,
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
337 "Usage: %s [-g] [-pl] [-o file] program [arg ...]\n",
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
338 progname);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
339 #else
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
340 fprintf(stderr, "Usage: %s program [arg ...]\n", progname);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
341 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
342 fflush(stderr);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
343 _exit(1);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
344 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
345
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
346 #ifdef JTEST
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
347 static mybool tflag = 0;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
348 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
349
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
350 /* read_flags -- interpret flags */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
351 static void read_flags(void) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
352 for (;;) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
353 argc--; argv++;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
354 if (argc == 0 || argv[0][0] != '-') return;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
355
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
356 if (strcmp(argv[0], "--") == 0) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
357 argc--; argv++;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
358 return;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
359 } else if (strcmp(argv[0], "-d") == 0) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
360 dflag++;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
361 } else if (strcmp(argv[0], "-v") == 0) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
362 fprintf(stderr, "%s\n", version);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
363 exit(0);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
364 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
365 #ifdef PROFILE
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
366 else if (argc >= 2 && strcmp(argv[0], "-o") == 0) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
367 profout = argv[1];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
368 argc--; argv++;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
369 } else if (strcmp(argv[0], "-g") == 0) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
370 gflag = TRUE;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
371 } else if (strcmp(argv[0], "-l") == 0
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
372 || strcmp(argv[0], "-pl") == 0) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
373 lflag = TRUE;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
374 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
375 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
376 #ifdef TRACE
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
377 else if (strcmp(argv[0], "-q") == 0) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
378 qflag++;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
379 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
380 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
381 #ifdef OBXDEB
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
382 else if (argc >= 2 && strcmp(argv[0], "-p") == 0) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
383 debug_socket = argv[1];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
384 argc--; argv++;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
385 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
386 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
387 #ifdef JTEST
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
388 else if (strcmp(argv[0], "-t") == 0) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
389 tflag++;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
390 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
391 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
392 else {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
393 usage();
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
394 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
395 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
396 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
397
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
398 #ifdef PROFILE
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
399 static void dump_lcounts(void) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
400 FILE *fp = fopen(dumpname, "w");
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
401 if (fp == NULL) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
402 fprintf(stderr, "%s: cannot write\n", dumpname);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
403 exit(1);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
404 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
405
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
406 for (int m = 0; m < nmods; m++)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
407 for (int n = 1; n <= modtab[m]->m_nlines; n++)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
408 if (modtab[m]->m_lcount[n-1] > 0)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
409 fprintf(fp, "%s %d %u\n", modtab[m]->m_name, n,
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
410 modtab[m]->m_lcount[n-1]);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
411
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
412 fclose(fp);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
413 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
414
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
415 static void print_profile(void) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
416 FILE *fp = stderr;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
417
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
418 if (profout != NULL) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
419 fp = fopen(profout, "w");
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
420 if (fp == NULL) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
421 fprintf(stderr, "%s: cannot write\n", profout);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
422 exit(1);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
423 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
424
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
425 fprintf(fp, "Command line:\n\n");
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
426 fprintf(fp, " %s", saved_argv[0]);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
427 for (int i = 1; i < saved_argc; i++)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
428 fprintf(fp, " %s", saved_argv[i]);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
429 fprintf(fp, "\n\n");
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
430 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
431
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
432 profile(fp);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
433
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
434 if (fp != stderr) fclose(fp);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
435 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
436 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
437
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
438 #ifdef JTEST
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
439 static void jit_test(void) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
440 dflag = vm_debug = 2; vm_aflag = 1;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
441 if (nmods < 2) panic("Can't find main module");
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
442 module m = modtab[nmods-2];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
443 for (int i = 0; i < nprocs; i++) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
444 proc p = proctab[i];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
445 if ((uchar *) p->p_addr >= m->m_addr
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
446 && (uchar *) p->p_addr < m->m_addr + m->m_length)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
447 jit_compile(p->p_addr);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
448 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
449 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
450 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
451
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
452 /* xmain_exit -- exit after program has finished */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
453 void NORETURN xmain_exit(int status) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
454 #ifdef OBXDEB
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
455 debug_break(NULL, NULL, NULL, "exit");
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
456 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
457 #ifdef PROFILE
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
458 print_profile();
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
459 if (lflag) dump_lcounts();
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
460 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
461 exit(status);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
462 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
463
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
464 /* error_exit -- exit after fatal error */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
465 void NORETURN error_exit(int status) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
466 #ifdef OBXDEB
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
467 debug_message("quit");
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
468 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
469 exit(status);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
470 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
471
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
472 /* The interpreter can be invoked in three ways:
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
473 (i) Explicitly as "obx [flags] bytefile args"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
474
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
475 (ii) Via a #! script as "obx bytefile args"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
476 or "bytefile bytefile args" under some Unixes
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
477
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
478 (iii) In a glued-together executable as "bytefile args"
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
479
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
480 Following the example of CAML Light, we recognize (iii) by seeing
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
481 if argv[0] names a bytefile that does not begin with #!. In that
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
482 case, we read that file for the bytecodes, and the program's args
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
483 follow immediately; otherwise, we look for flags and the name of
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
484 the bytefile before the program's args. In either case, we must be
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
485 prepared to search the shell path to find the bytefile.
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
486
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
487 These rules are modified a bit if a custom file is built for
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
488 profiling: in that case, we look for switches even in case (iii). */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
489
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
490 int main(int ac, char *av[]) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
491 FILE *fp;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
492 char *codefile;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
493
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
494 argc = ac; argv = av;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
495 progname = argv[0];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
496
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
497 /* Read the command line first to handle -v */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
498 codefile = search_path(argv[0]);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
499 if (codefile != NULL && custom_file(codefile)) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
500 #ifdef PROFILE
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
501 char *prog = argv[0];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
502 read_flags();
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
503 /* Fill the program name back in as argv[0] */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
504 argc++; argv--;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
505 argv[0] = prog;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
506 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
507 } else {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
508 read_flags();
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
509 if (argc < 1) usage();
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
510 codefile = search_path(argv[0]);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
511 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
512
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
513 #ifdef OBXDEB
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
514 /* Now connect to the debugger process */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
515 debug_init();
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
516 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
517
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
518 if (codefile == NULL) panic("can't find %s", argv[0]);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
519
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
520 gc_init();
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
521
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
522 #ifdef JIT
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
523 vm_debug = dflag;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
524 interpreter = wrap_prim(jit_trap);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
525 #else
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
526 interpreter = wrap_prim(interp);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
527 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
528 dyntrap = wrap_prim(dltrap);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
529 #ifdef USEFFI
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
530 dynstub = wrap_prim(dlstub);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
531 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
532
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
533 #ifdef M64X32
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
534 /* Allocate ob_res and statlink in 32-bit addressible storage */
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
535 _result = (value *) scratch_alloc(2 * sizeof(value));
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
536 _stat = (value **) scratch_alloc(sizeof(value *));
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
537 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
538
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
539 fp = fopen(codefile, "rb");
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
540 if (fp == NULL) panic("can't open %s", codefile);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
541 load_file(fp);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
542 fclose(fp);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
543
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
544 #ifdef TRACE
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
545 if (dflag) dump();
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
546 if (qflag) exit(0);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
547 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
548
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
549 #ifdef JTEST
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
550 if (tflag) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
551 jit_test();
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
552 exit(0);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
553 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
554 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
555
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
556 #ifdef PROFILE
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
557 if (nprocs == 0)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
558 panic("no symbol table in object file");
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
559
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
560 prof_init();
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
561 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
562
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
563 #ifdef OBXDEB
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
564 debug_break(NULL, NULL, NULL, "ready");
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
565 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
566 #ifdef DEBUG
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
567 if (dflag)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
568 printf("Starting program at address %ld\n",
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
569 (long) ((uchar *) entry - dmem));
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
570 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
571 run(entry);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
572 xmain_exit(0);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
573 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
574
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
575 #ifdef JIT
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
576 void interp(value *bp) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
577 panic("dummy interp called");
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
578 }
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
579 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
580
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
581 word wrap_prim(primitive *prim) {
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
582 #ifdef JIT
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
583 return vm_wrap((funptr) prim);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
584 #else
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
585 #ifndef M64X32
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
586 return (word) prim;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
587 #else
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
588 primitive **wrapper =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
589 (primitive **) scratch_alloc(sizeof(primitive *));
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
590 *wrapper = prim;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
591 return address(wrapper);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
592 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
593 #endif
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
594 }