summaryrefslogtreecommitdiff
path: root/Build/source/utils/xml2pmx/xml2pmx-src/xmain.c
diff options
context:
space:
mode:
Diffstat (limited to 'Build/source/utils/xml2pmx/xml2pmx-src/xmain.c')
-rw-r--r--Build/source/utils/xml2pmx/xml2pmx-src/xmain.c631
1 files changed, 631 insertions, 0 deletions
diff --git a/Build/source/utils/xml2pmx/xml2pmx-src/xmain.c b/Build/source/utils/xml2pmx/xml2pmx-src/xmain.c
new file mode 100644
index 00000000000..6dd15da0b0d
--- /dev/null
+++ b/Build/source/utils/xml2pmx/xml2pmx-src/xmain.c
@@ -0,0 +1,631 @@
+/*
+ * xmain.c
+ *
+ * This file is part of the Oxford Oberon-2 compiler
+ * Copyright (c) 2006--2016 J. M. Spivey
+ * All rights reserved
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright notice,
+ * this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ * this list of conditions and the following disclaimer in the documentation
+ * and/or other materials provided with the distribution.
+ * 3. The name of the author may not be used to endorse or promote products
+ * derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
+ * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
+ * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
+ * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+#define main xmain
+
+#include <string.h>
+#include <stdlib.h>
+
+#define EXTERN
+#include "obx.h"
+#include "keiko.h"
+#include "exec.h"
+
+#ifdef JIT
+#include "vm.h"
+#ifdef DEBUG
+#define JTEST 1
+#endif
+#endif
+
+#ifdef PROFILE
+#define MYNAME "profiler"
+#else
+#ifdef OBXDEB
+#define MYNAME "debugging monitor"
+#else
+#define MYNAME "runtime system"
+#endif
+#endif
+
+const char *version =
+"Oxford Oberon-2 " MYNAME " version " PACKAGE_VERSION " [build " REVID "]"
+#ifdef JIT
+ " (JIT)"
+#else
+ ""
+#endif
+#ifdef DEBUG
+ " (debug)"
+#else
+ ""
+#endif
+ ;
+extern const char *lib_version;
+const char *copyright = "Copyright (C) 1999--2012 J. M. Spivey";
+
+extern int vm_debug;
+
+/* Helper functions for the loader */
+
+void make_module(char *name, word addr, int chksum, int nlines) {
+ module m = scratch_alloc_atomic(sizeof(struct _module));
+ static int nm = 0;
+
+ if (modtab == NULL)
+ modtab = scratch_alloc_atomic(nmods * sizeof(module));
+
+ m->m_name = name;
+ m->m_addr =addr;
+#ifdef PROFILE
+ m->m_nlines = nlines;
+ m->m_lcount = NULL;
+ if (lflag && nlines > 0) {
+ m->m_lcount = scratch_alloc_atomic(nlines * sizeof(unsigned));
+ memset(m->m_lcount, 0, nlines * sizeof(int));
+ }
+#endif
+#ifdef OBXDEB
+ debug_message("module %s %#x", name, chksum);
+#endif
+ if (nm >= nmods) panic("Too many modules");
+ modtab[nm++] = m;
+}
+
+void make_proc(char *name, word addr) {
+ proc p = scratch_alloc_atomic(sizeof(struct _proc));
+ static int np = 0;
+
+ if (proctab == NULL)
+ proctab = scratch_alloc_atomic(nprocs * sizeof(proc));
+
+ p->p_name = name;
+ p->p_addr = addr;
+#ifdef PROFILE
+ p->p_calls = p->p_rec = p->p_self = p->p_child = 0;
+ p->p_parents = p->p_children = NULL;
+#endif
+#ifdef OBXDEB
+ value *cp = ptrcast(value, p->p_addr);
+ debug_message("proc %s %#x %#x %d", name, addr,
+ cp[CP_CODE].a, cp[CP_SIZE].i);
+#endif
+ if (np >= nprocs) panic("Too many procs");
+ proctab[np++] = p;
+}
+
+void make_symbol(const char *kind, char *name, word addr) {
+#ifdef OBXDEB
+ debug_message("%s %s %#x", kind, name, addr);
+#endif
+}
+
+/* fix_sizes -- calculate module lengths */
+void fix_sizes(int dseg) {
+ word p = dsegaddr(dmem + dseg);
+ int i;
+
+ for (i = nmods-1; i >= 0; i--) {
+ modtab[i]->m_length = p - modtab[i]->m_addr;
+ p = modtab[i]->m_addr;
+ }
+}
+
+
+/* Runtime errors */
+
+#ifndef OBXDEB
+#define TOP 5 /* Number of frames shown at top and bottom */
+#define BOT 5
+#define GAP 10 /* Don't omit less than this many frames */
+#define NBUF (BOT+GAP-1)
+
+static void backtrace(value *bp) {
+ value *fp = bp, *cp = valptr(bp[CP]);
+ proc p = find_proc(dsegaddr(cp));
+ int n, j;
+ proc fbuf[NBUF];
+
+ fprintf(stderr, "In procedure %s\n", p->p_name);
+
+ /* Chain down the stack, printing the first TOP frames,
+ and saving the last NBUF in a circular buffer. */
+ for (n = 0;; n++) {
+ /* Each frame contains the cp and bp of its caller */
+ fp = valptr(fp[BP]); /* Base pointer of next frame */
+ if (fp == NULL) break;
+ cp = valptr(fp[CP]); /* Constant pool of next frame */
+ fbuf[n%NBUF] = p = find_proc(dsegaddr(cp));
+ if (n < TOP)
+ fprintf(stderr, " called from %s\n", p->p_name);
+ }
+
+ /* Now the last NBUF frames are f(n-NBUF), ..., f(n-1)
+ where f(i) = fbuf[i%NBUF] -- unless there are fewer
+ then NBUF frames in all. */
+
+ if (n < TOP+GAP+BOT)
+ /* Print the n-TOP frames not printed already */
+ j = TOP;
+ else {
+ /* Omit n-(TOP+BOT) frames (at least GAP) and print the
+ last BOT frames */
+ fprintf(stderr, " ... %d intervening frames omitted ...\n",
+ n-(TOP+BOT));
+ j = n-BOT;
+ }
+
+ /* Print frames j, ..., n-1 */
+ for (; j < n; j++)
+ fprintf(stderr, " called from %s\n", fbuf[j%NBUF]->p_name);
+}
+#endif
+
+static const char *message(int code) {
+ switch (code) {
+ case E_CAST:
+ return "dynamic type error in cast";
+ case E_ASSIGN:
+ return "dynamic type error in record assignment";
+ case E_CASE:
+ return "no matching label in CASE statement";
+ case E_WITH:
+ return "no matching type guard in WITH statement";
+ case E_RETURN:
+ return "function failed to return a result";
+ case E_BOUND:
+ return "array bound error";
+ case E_NULL:
+ return "null pointer error";
+ case E_DIV:
+ return "DIV or MOD by zero";
+ case E_FDIV:
+ return "division by zero";
+ case E_STACK:
+ return "stack overflow";
+ case E_GLOB:
+ return "assignment of local procedure";
+ default:
+ return "the impossible has happened";
+ }
+}
+
+/* error_stop -- runtime error with explicit message text */
+void error_stop(const char *msg, int val, int line, value *bp, uchar *pc) {
+ value *cp = valptr(bp[CP]);
+
+#ifdef OBXDEB
+ char buf[256];
+ sprintf(buf, msg, val);
+ debug_break(cp, bp, pc, "error %d %s", line, buf);
+#else
+ module mod = find_module(dsegaddr(cp));
+
+ fprintf(stderr, "Runtime error: ");
+ fprintf(stderr, msg, val);
+ if (line > 0) fprintf(stderr, " on line %d", line);
+ if (mod != NULL && strcmp(mod->m_name, "_Builtin") != 0)
+ fprintf(stderr, " in module %s", mod->m_name);
+ fprintf(stderr, "\n");
+ fflush(stderr);
+
+ if (nprocs == 0)
+ fprintf(stderr, "(No debugging information available)\n");
+ else if (bp != NULL)
+ backtrace(bp);
+
+ fflush(stderr);
+#endif
+
+ exit(2);
+}
+
+/* runtime_error -- report a runtime error */
+void runtime_error(int m, int line, value *bp, uchar *pc) {
+ error_stop(message(m), 0, line, bp, pc);
+}
+
+/* rterror -- simple version of runtime_error for JIT */
+void rterror(int num, int line, value *bp) {
+ runtime_error(num, line, bp, NULL);
+}
+
+/* stkoflo -- stack overflow handler for JIT */
+void stkoflo(value *bp) {
+ runtime_error(E_STACK, 0, bp, NULL);
+}
+
+
+/* Startup */
+
+#define argc saved_argc
+#define argv saved_argv
+
+static void run(value *prog) {
+ value *sp;
+
+ /* Allow 32-word safety margin (for tracing) */
+ sp = (value *) (stack + stack_size) - 32;
+
+ sp -= HEAD;
+ sp[BP].a = 0;
+ sp[PC].a = 0;
+ sp[CP].a = dsegaddr(prog);
+ primcall(prog, sp);
+}
+
+#ifndef PRELOAD
+mybool custom_file(char *name) {
+ char buf[4];
+ FILE *fp;
+ int nread;
+ mybool result;
+
+ fp = fopen(name, "rb");
+ if (fp == NULL) return FALSE;
+ fseek(fp, - (long) sizeof(trailer), SEEK_END);
+ nread = fread(buf, 1, 4, fp);
+ if (nread < 4 || strncmp(buf, MAGIC, 4) != 0)
+ result = FALSE;
+ else {
+ fseek(fp, 0, SEEK_SET);
+ nread = fread(buf, 1, 2, fp);
+ result = (nread == 2 && strncmp(buf, "#!", 2) != 0);
+ }
+ fclose(fp);
+ return result;
+}
+
+#ifdef WINDOWS
+#include <windows.h>
+#include <winbase.h>
+
+char *search_path(char *name) {
+ static char buf[_MAX_PATH];
+ char *filepart;
+
+ if (SearchPath(NULL, name, ".exe", _MAX_PATH, buf, &filepart) == 0)
+ return NULL;
+
+ return buf;
+}
+#else
+#include <sys/stat.h>
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
+char *search_path(char *name) {
+ char *path;
+ static char buf[256];
+ struct stat stbuf;
+
+ if (name == NULL || strchr(name, '/') != NULL) return name;
+
+ path = getenv("PATH");
+ if (path == NULL) return NULL;
+
+ for (char *p = path, *q; p != NULL; p = q) {
+ q = strchr(p, ':');
+ char *r;
+ if (q == NULL) {
+ strcpy(buf, p);
+ r = buf + strlen(p);
+ } else {
+ strncpy(buf, p, q-p);
+ r = buf + (q-p); q++;
+ }
+ if (r > buf) *r++ = '/';
+ strcpy(r, name);
+
+ if (access(buf, R_OK) == 0 && stat(buf, &stbuf) == 0
+ && S_ISREG(stbuf.st_mode))
+ return buf;
+ }
+
+ return NULL;
+}
+#endif
+
+static char *progname;
+#ifdef PROFILE
+static char *profout;
+static const char *dumpname = "obprof.out";
+#endif
+
+static void usage(void) {
+#ifdef PROFILE
+ fprintf(stderr,
+ "Usage: %s [-g] [-pl] [-o file] program [arg ...]\n",
+ progname);
+#else
+ fprintf(stderr, "Usage: %s program [arg ...]\n", progname);
+#endif
+ fflush(stderr);
+ _exit(1);
+}
+
+#ifdef JTEST
+static mybool tflag = 0;
+#endif
+
+/* read_flags -- interpret flags */
+static void read_flags(void) {
+ for (;;) {
+ argc--; argv++;
+ if (argc == 0 || argv[0][0] != '-') return;
+
+ if (strcmp(argv[0], "--") == 0) {
+ argc--; argv++;
+ return;
+ } else if (strcmp(argv[0], "-d") == 0) {
+ dflag++;
+ } else if (strcmp(argv[0], "-v") == 0) {
+ fprintf(stderr, "%s\n", version);
+ fprintf(stderr, "%s\n", lib_version);
+ exit(0);
+ }
+#ifdef PROFILE
+ else if (argc >= 2 && strcmp(argv[0], "-o") == 0) {
+ profout = argv[1];
+ argc--; argv++;
+ } else if (strcmp(argv[0], "-g") == 0) {
+ gflag = TRUE;
+ } else if (strcmp(argv[0], "-l") == 0
+ || strcmp(argv[0], "-pl") == 0) {
+ lflag = TRUE;
+ }
+#endif
+#ifdef TRACE
+ else if (strcmp(argv[0], "-q") == 0) {
+ qflag++;
+ }
+#endif
+#ifdef OBXDEB
+ else if (argc >= 2 && strcmp(argv[0], "-p") == 0) {
+ debug_socket = argv[1];
+ argc--; argv++;
+ }
+#endif
+#ifdef JTEST
+ else if (strcmp(argv[0], "-t") == 0) {
+ tflag++;
+ }
+#endif
+ else {
+ usage();
+ }
+ }
+}
+
+#ifdef PROFILE
+static void dump_lcounts(void) {
+ FILE *fp = fopen(dumpname, "w");
+ if (fp == NULL) {
+ fprintf(stderr, "%s: cannot write\n", dumpname);
+ exit(1);
+ }
+
+ for (int m = 0; m < nmods; m++)
+ for (int n = 1; n <= modtab[m]->m_nlines; n++)
+ if (modtab[m]->m_lcount[n-1] > 0)
+ fprintf(fp, "%s %d %u\n", modtab[m]->m_name, n,
+ modtab[m]->m_lcount[n-1]);
+
+ fclose(fp);
+}
+
+static void print_profile(void) {
+ FILE *fp = stderr;
+
+ if (profout != NULL) {
+ fp = fopen(profout, "w");
+ if (fp == NULL) {
+ fprintf(stderr, "%s: cannot write\n", profout);
+ exit(1);
+ }
+
+ fprintf(fp, "Command line:\n\n");
+ fprintf(fp, " %s", saved_argv[0]);
+ for (int i = 1; i < saved_argc; i++)
+ fprintf(fp, " %s", saved_argv[i]);
+ fprintf(fp, "\n\n");
+ }
+
+ profile(fp);
+
+ if (fp != stderr) fclose(fp);
+}
+#endif
+#endif
+
+#ifdef JTEST
+static void jit_test(void) {
+ dflag = vm_debug = 2; vm_aflag = 1;
+ if (nmods < 2) panic("Can't find main module");
+ module m = modtab[nmods-2];
+ for (int i = 0; i < nprocs; i++) {
+ proc p = proctab[i];
+ if (p->p_addr >= m->m_addr && p->p_addr < m->m_addr + m->m_length)
+ jit_compile(ptrcast(value, p->p_addr));
+ }
+}
+#endif
+
+/* xmain_exit -- exit after program has finished */
+void NORETURN xmain_exit(int status) {
+#ifdef OBXDEB
+ debug_break(NULL, NULL, NULL, "exit");
+#endif
+#ifdef PROFILE
+ print_profile();
+ if (lflag) dump_lcounts();
+#endif
+ exit(status);
+}
+
+/* error_exit -- exit after fatal error */
+void NORETURN error_exit(int status) {
+#ifdef OBXDEB
+ debug_message("quit");
+#endif
+ exit(status);
+}
+
+/* The interpreter can be invoked in three ways:
+ (i) Explicitly as "obx [flags] bytefile args"
+
+ (ii) Via a #! script as "obx bytefile args"
+ or "bytefile bytefile args" under some Unixes
+
+ (iii) In a glued-together executable as "bytefile args"
+
+ Following the example of CAML Light, we recognize (iii) by seeing
+ if argv[0] names a bytefile that does not begin with #!. In that
+ case, we read that file for the bytecodes, and the program's args
+ follow immediately; otherwise, we look for flags and the name of
+ the bytefile before the program's args. In either case, we must be
+ prepared to search the shell path to find the bytefile.
+
+ These rules are modified a bit if a custom file is built for
+ profiling: in that case, we look for switches even in case (iii).
+
+ Actually, there's a fourth way: linking the interpreter with a
+ "preloaded" image. */
+
+int main(int ac, char *av[]) {
+#ifndef M64X32
+ if (sizeof(uchar *) != 4) panic("Bad pointer size");
+#endif
+
+ argc = ac; argv = av;
+
+#ifndef PRELOAD
+ progname = argv[0];
+
+ /* Read the command line first to handle -v */
+ char *codefile = search_path(argv[0]);
+ if (codefile != NULL && custom_file(codefile)) {
+#ifdef PROFILE
+ char *prog = argv[0];
+ read_flags();
+ /* Fill the program name back in as argv[0] */
+ argc++; argv--;
+ argv[0] = prog;
+#endif
+ } else {
+ read_flags();
+ if (argc < 1) usage();
+ codefile = search_path(argv[0]);
+ }
+
+ if (codefile == NULL) panic("can't find %s", argv[0]);
+#endif
+
+#ifdef OBXDEB
+ /* Now connect to the debugger process */
+ debug_init();
+#endif
+
+ gc_init();
+
+#ifdef JIT
+ vm_debug = dflag;
+ interpreter = wrap_prim(jit_trap);
+#else
+ interpreter = wrap_prim(interp);
+#endif
+ dyntrap = wrap_prim(dltrap);
+#ifdef USE_FFI
+ dynstub = wrap_prim(dlstub);
+#endif
+
+#ifdef PRELOAD
+ load_image();
+#else
+ FILE *fp = fopen(codefile, "rb");
+ if (fp == NULL) panic("can't open %s", codefile);
+ load_file(fp);
+ fclose(fp);
+#endif
+
+#ifdef TRACE
+ if (dflag) dump();
+ if (qflag) exit(0);
+#endif
+
+#ifdef JTEST
+ if (tflag) {
+ jit_test();
+ exit(0);
+ }
+#endif
+
+#ifdef PROFILE
+ if (nprocs == 0)
+ panic("no symbol table in object file");
+
+ prof_init();
+#endif
+
+#ifdef OBXDEB
+ debug_break(NULL, NULL, NULL, "ready");
+#endif
+#ifdef DEBUG
+ if (dflag)
+ printf("Starting program at address %ld\n",
+ (long) ((uchar *) entry - dmem));
+#endif
+
+ run(entry);
+ xmain_exit(0);
+}
+
+#ifdef JIT
+value *interp(value *bp) {
+ panic("dummy interp called");
+ return NULL;
+}
+#endif
+
+word wrap_prim(primitive *prim) {
+#ifdef JIT
+ return vm_wrap((funptr) prim);
+#else
+#ifndef M64X32
+ return (word) prim;
+#else
+ word addr = virtual_alloc_atomic(sizeof(primitive *));
+ primitive **wrapper = ptrcast(primitive *, addr);
+ *wrapper = prim;
+ return addr;
+#endif
+#endif
+}