smalltalk-tng

view experiments/codegen/shell.c @ 321:c4a0718c2d3c

find changesets by author, revision, files, or words in the commit message
Sketch of dependencies
author Tony Garnock-Jones <tonygarnockjones@gmail.com>
date Sat Oct 08 15:36:03 2011 -0400 (7 months ago)
parents e0938ba5e802
children
line source
1 #include <stdio.h>
2 #include <string.h>
3 #include <stdlib.h>
4 #include <stdarg.h>
5 #include <errno.h>
6 #include <dlfcn.h>
7 #include <stdint.h>
8
9 #include "scheme-private.h"
10 #include "scheme.h"
11
12 #include "libdis.h"
13
14 #ifndef RTLD_DEFAULT
15 #define RTLD_DEFAULT NULL
16 #endif
17
18 static void die(char const *format, ...) {
19 va_list vl;
20 va_start(vl, format);
21 vfprintf(stderr, format, vl);
22 va_end(vl);
23 exit(1);
24 }
25
26 static void apply_relocations(char *codevec, int len, pointer relocations) {
27 printf("New function is at 0x%08x = %d\n", (unsigned) codevec, (unsigned) codevec);
28 while (is_pair(relocations)) {
29 pointer relocation = pair_car(relocations);
30 int code_offset = ivalue(pair_cdr(relocation));
31 long target = ivalue(pair_car(relocation));
32 uint32_t v = target - (uint32_t) codevec - (code_offset + 4);
33
34 relocations = pair_cdr(relocations);
35
36 printf("Patching offset %d to target 0x%08x; relative offset is 0x%08x\n",
37 code_offset, (unsigned) target, v);
38 memcpy(&codevec[code_offset], &v, sizeof(uint32_t));
39 }
40 }
41
42
43 static pointer scm_build_native(scheme *sc, pointer args) {
44 if (!is_pair(args)) {
45 return sc->F;
46 } else {
47 pointer s = pair_car(args);
48 char *bytes;
49 int len;
50 char *newbytes;
51
52 if (!is_string(s)) {
53 return sc->F;
54 }
55
56 len = s->_object._string._length;
57 bytes = s->_object._string._svalue;
58 newbytes = malloc(len);
59 memcpy(newbytes, bytes, len);
60 if (is_pair(pair_cdr(args))) {
61 apply_relocations(newbytes, len, pair_car(pair_cdr(args)));
62 }
63
64 return mk_foreign_func(sc, (foreign_func) newbytes);
65 }
66 }
67
68 static void disassemble(void *bytes, int len) {
69 char line[128];
70 int pos = 0;
71 x86_insn_t i;
72
73 x86_init(opt_none, NULL, NULL);
74
75 while (pos < len) {
76 int i_size = x86_disasm((unsigned char *) bytes, len, 0, pos, &i);
77 if (i_size) {
78 x86_format_insn(&i, line, sizeof(line), native_syntax);
79 printf("%s\n", line);
80 pos += i_size;
81 } else {
82 printf("Invalid instruction\n");
83 pos++;
84 }
85 }
86
87 x86_cleanup();
88 }
89
90 static pointer scm_disassemble(scheme *sc, pointer args) {
91 pointer s;
92
93 if (!is_pair(args)) return sc->F;
94 s = pair_car(args);
95
96 if (is_string(s)) {
97 int len = s->_object._string._length;
98 char *bytes = s->_object._string._svalue;
99 disassemble(bytes, len);
100 } else if (is_number(s)) {
101 char *bytes = (char *) ivalue(s);
102 int len = (int) ivalue(pair_car(pair_cdr(args)));
103 disassemble(bytes, len);
104 } else {
105 return sc->F;
106 }
107
108 return sc->T;
109 }
110
111 static pointer scm_lookup_native(scheme *sc, pointer args) {
112 pointer s;
113 char *bytes;
114 int len;
115
116 if (!is_pair(args)) return sc->F;
117 s = pair_car(args);
118 if (!is_string(s)) return sc->F;
119
120 len = s->_object._string._length;
121 bytes = s->_object._string._svalue;
122
123 {
124 char sym[128];
125 void *p;
126
127 if (len >= sizeof(sym)) len = sizeof(sym) - 1;
128 memcpy(sym, bytes, len);
129 sym[len] = '\0';
130 p = dlsym(RTLD_DEFAULT, sym);
131
132 if (p != NULL) {
133 return mk_integer(sc, (long) p);
134 } else {
135 return sc->F;
136 }
137 }
138 }
139
140 static pointer scm_string_address(scheme *sc, pointer args) {
141 pointer s;
142 if (!is_pair(args)) return sc->F;
143 s = pair_car(args);
144 if (!is_string(s)) return sc->F;
145 return mk_integer(sc, (long) s->_object._string._svalue);
146 }
147
148 static pointer scm_shr(scheme *sc, pointer args) {
149 pointer n, m;
150 if (!is_pair(args)) return sc->F;
151 n = pair_car(args);
152 args = pair_cdr(args);
153 if (!is_number(n)) return sc->F;
154 if (!is_pair(args)) return sc->F;
155 m = pair_car(args);
156 if (!is_number(m)) return sc->F;
157 return mk_integer(sc, ivalue(n) >> ivalue(m));
158 }
159
160 int main(int argc, char *argv[]) {
161 scheme *sc;
162 FILE *f;
163 scheme_registerable fns[] = {
164 { &scm_build_native, "build-native-function" },
165 { &scm_disassemble, "disassemble" },
166 { &scm_lookup_native, "lookup-native-symbol" },
167 { &scm_string_address, "string-address" },
168 { &scm_shr, "shr" },
169 };
170
171 sc = scheme_init_new();
172 if (!sc) die("Could not initialise scheme\n");
173
174 f = fopen("codegen.scm", "rt");
175 if (!f) die("Could not open codegen.scm: %s\n", strerror(errno));
176
177 scheme_set_input_port_file(sc, stdin);
178 scheme_set_output_port_file(sc, stdout);
179 scheme_register_foreign_func_list(sc, &fns[0], sizeof(fns) / sizeof(fns[0]));
180 scheme_load_file(sc, f);
181 fclose(f);
182 scheme_load_file(sc, stdin);
183 scheme_deinit(sc);
184 free(sc);
185
186 return 0;
187 }