runtime.c 10.8 KB
Newer Older
mb0's avatar
Up.    
mb0 committed
1
/* vim:cindent:ts=2:sw=2:expandtab */
2

mb0's avatar
mb0 committed
3
#include "dis.h"
4

mb0's avatar
mb0 committed
5
__unwrapped_obj heap[__RT_HEAP_SIZE] __attribute__((aligned(8)));
6
__objref hp = &heap[__RT_HEAP_SIZE];
mb0's avatar
mb0 committed
7

mb0's avatar
mb0 committed
8
9
10
11
@fieldnames@

@tagnames@

mb0's avatar
mb0 committed
12
13
@prototypes@

mb0's avatar
mb0 committed
14
15
16
17
18
19
20
21
22
23
24
struct __unwrapped_immediate __unwrapped_UNIT =
   {.header.tag = __NIL};
struct __unwrapped_bv __unwrapped_TRUE =
   {.header.tag = __BV,
    .sz = 1,
    .vec = 1};
struct __unwrapped_bv __unwrapped_FALSE =
   {.header.tag = __BV,
    .sz = 1,
    .vec = 0};

mb0's avatar
mb0 committed
25
__obj __UNIT = __WRAP(&__unwrapped_UNIT);
mb0's avatar
mb0 committed
26
27
__obj __TRUE = __WRAP(&__unwrapped_TRUE);
__obj __FALSE = __WRAP(&__unwrapped_FALSE);
28

mb0's avatar
mb0 committed
29
30
void __fatal (char *fmt, ...) {
  va_list ap;
mb0's avatar
mb0 committed
31
  va_start(ap,fmt);
mb0's avatar
Up.    
mb0 committed
32
  fprintf(stderr,"FATAL:[");
mb0's avatar
mb0 committed
33
  vfprintf(stderr,fmt,ap);
mb0's avatar
Up.    
mb0 committed
34
  fprintf(stderr,"]\n");
mb0's avatar
mb0 committed
35
36
37
38
  va_end(ap);
  abort();
}

mb0's avatar
mb0 committed
39
40
41
42
__obj __and (__obj a_, __obj b_) {
  __word a = a_->bv.vec;
  __word b = b_->bv.vec;
  __word sz = a_->bv.sz;
mb0's avatar
mb0 committed
43
  __LOCAL0(x);
mb0's avatar
mb0 committed
44
45
46
47
48
49
    __BV_BEGIN(x,sz);
    __BV_INIT(a & b);
    __BV_END(x,sz);
  return (x);
}

mb0's avatar
Foo.    
mb0 committed
50
51
52
53
54
55
56
57
58
59
__obj __add (__obj A, __obj B) {
  __word a = A->z.value;
  __word b = B->z.value;
  __LOCAL0(x);
    __INT_BEGIN(x);
    __INT_INIT(a + b);
    __INT_END(x);
  return (x);
}

mb0's avatar
mb0 committed
60
61
62
63
64
65
66
67
68
69
__obj __sub (__obj A, __obj B) {
  __word a = A->z.value;
  __word b = B->z.value;
  __LOCAL0(x);
    __INT_BEGIN(x);
    __INT_INIT(a - b);
    __INT_END(x);
  return (x);
}

mb0's avatar
Foo.    
mb0 committed
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
/* FIXME */
__obj __sx (__obj x) {
  __LOCAL0(y);
    __INT_BEGIN(y);
    __INT_INIT(x->bv.vec);
    __INT_END(y);
  return (y);
}

/* FIXME */
__obj __zx (__obj x) {
  __LOCAL0(y);
    __INT_BEGIN(y);
    __INT_INIT(x->bv.vec);
    __INT_END(y);
  return (y);
}

mb0's avatar
mb0 committed
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
__obj __concat (__obj a_, __obj b_) {
  __word a = a_->bv.vec;
  __word b = b_->bv.vec;
  __word szOfA = a_->bv.sz;
  __word szOfB = b_->bv.sz;
  __word sz = szOfA + szOfB;
  __LOCAL0(x);
    __BV_BEGIN(x,sz);
    __BV_INIT((a << szOfB) | b);
    __BV_END(x,sz);
  return (x);
}

__obj __equal (__obj a_, __obj b_) {
  __word a = a_->bv.vec;
  __word b = b_->bv.vec;
mb0's avatar
mb0 committed
104
105
106
  __word szOfA = a_->bv.sz;
  __word szOfB = b_->bv.sz;
  __LOCAL(x, (a == b && szOfA == szOfB) ? __TRUE : __FALSE); 
mb0's avatar
mb0 committed
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
  return (x);
}

__obj __not (__obj a_) {
  __word a = a_->bv.vec;
  __word sz = a_->bv.sz;
  __LOCAL0(x);
    __BV_BEGIN(x,sz);
    __BV_INIT(~a & ((1 << sz)-1));
    __BV_END(x,sz);
  return (x);
}

__obj __raise (__obj o) {
  printf("raising: ");
  __println(o);
mb0's avatar
Up.    
mb0 committed
123
  __fatal("Unhandled exception");
mb0's avatar
mb0 committed
124
  return (o);
mb0's avatar
mb0 committed
125
126
}

mb0's avatar
Up.    
mb0 committed
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
__obj __consume8 (__obj s) {
  __LOCAL(blob, __RECORD_SELECT(s,___blob));
  __char* buf = blob->blob.blob;
  __word sz = blob->blob.sz;
  if (sz == 0)
    __fatal("end-of-blob");
  __char x = *buf;
  __LOCAL0(v);
    __BV_BEGIN(v,8);
    __BV_INIT(x);
    __BV_END(v,8);
  __LOCAL0(blobb);
    __BLOB_BEGIN(blobb);
    __BLOB_INIT(buf+1,sz-1);
    __BLOB_END(blobb);
  __LOCAL0(ss);
    __RECORD_BEGIN_UPDATE(ss,s);
    __RECORD_UPDATE(___blob,blobb);
    __RECORD_END_UPDATE(ss);
  __LOCAL0(a);
    __RECORD_BEGIN(a,2);
    __RECORD_ADD(___1,v);
    __RECORD_ADD(___2,ss);
    __RECORD_END(a,2);
  return (a);
}

__obj __unconsume8 (__obj s) {
mb0's avatar
mb0 committed
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
  __LOCAL(blob, __RECORD_SELECT(s,___blob));
  __char* buf = blob->blob.blob;
  __word sz = blob->blob.sz;
  __LOCAL0(blobb);
    __BLOB_BEGIN(blobb);
    __BLOB_INIT(buf-1,sz+1);
    __BLOB_END(blobb);
  __LOCAL0(ss);
    __RECORD_BEGIN_UPDATE(ss,s);
    __RECORD_UPDATE(___blob,blobb);
    __RECORD_END_UPDATE(ss);
  __LOCAL0(a);
    __RECORD_BEGIN(a,2);
    __RECORD_ADD(___1,__UNIT);
    __RECORD_ADD(___2,ss);
    __RECORD_END(a,2);
  return (a);
}

mb0's avatar
Up.    
mb0 committed
174
__obj __consume16 (__obj s) {
mb0's avatar
mb0 committed
175
176
177
  __LOCAL(blob, __RECORD_SELECT(s,___blob));
  __char* buf = blob->blob.blob;
  __word sz = blob->blob.sz;
mb0's avatar
Up.    
mb0 committed
178
179
180
181
  if (sz < 2)
    __fatal("end-of-blob");
  uint16_t x1 = buf[0];
  uint16_t x2 = buf[1]<<8;
mb0's avatar
mb0 committed
182
  __LOCAL0(v);
mb0's avatar
Up.    
mb0 committed
183
184
185
    __BV_BEGIN(v,16);
    __BV_INIT((x1|x2)&0xffff);
    __BV_END(v,16);
mb0's avatar
mb0 committed
186
187
  __LOCAL0(blobb);
    __BLOB_BEGIN(blobb);
mb0's avatar
Up.    
mb0 committed
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
    __BLOB_INIT(buf+2,sz-2);
    __BLOB_END(blobb);
  __LOCAL0(ss);
    __RECORD_BEGIN_UPDATE(ss,s);
    __RECORD_UPDATE(___blob,blobb);
    __RECORD_END_UPDATE(ss);
  __LOCAL0(a);
    __RECORD_BEGIN(a,2);
    __RECORD_ADD(___1,v);
    __RECORD_ADD(___2,ss);
    __RECORD_END(a,2);
  return (a);
}

__obj __unconsume16 (__obj s) {
  __LOCAL(blob, __RECORD_SELECT(s,___blob));
  __char* buf = blob->blob.blob;
  __word sz = blob->blob.sz;
  __LOCAL0(blobb);
    __BLOB_BEGIN(blobb);
    __BLOB_INIT(buf-2,sz+2);
    __BLOB_END(blobb);
  __LOCAL0(ss);
    __RECORD_BEGIN_UPDATE(ss,s);
    __RECORD_UPDATE(___blob,blobb);
    __RECORD_END_UPDATE(ss);
  __LOCAL0(a);
    __RECORD_BEGIN(a,2);
    __RECORD_ADD(___1,__UNIT);
    __RECORD_ADD(___2,ss);
    __RECORD_END(a,2);
  return (a);
}

__obj __consume32 (__obj s) {
  __LOCAL(blob, __RECORD_SELECT(s,___blob));
  __char* buf = blob->blob.blob;
  __word sz = blob->blob.sz;
  if (sz < 4)
    __fatal("end-of-blob");
  uint32_t x1 = buf[0];
  uint32_t x2 = buf[1]<<8;
  uint32_t x3 = buf[2]<<16;
  uint32_t x4 = buf[3]<<24;
  __LOCAL0(v);
    __BV_BEGIN(v,32);
    __BV_INIT((x1|x2|x3|x4)&0xffffffff);
    __BV_END(v,32);
  __LOCAL0(blobb);
    __BLOB_BEGIN(blobb);
    __BLOB_INIT(buf+2,sz-2);
mb0's avatar
mb0 committed
239
240
241
242
243
244
245
246
247
248
249
    __BLOB_END(blobb);
  __LOCAL0(ss);
    __RECORD_BEGIN_UPDATE(ss,s);
    __RECORD_UPDATE(___blob,blobb);
    __RECORD_END_UPDATE(ss);
  __LOCAL0(a);
    __RECORD_BEGIN(a,2);
    __RECORD_ADD(___1,v);
    __RECORD_ADD(___2,ss);
    __RECORD_END(a,2);
  return (a);
mb0's avatar
mb0 committed
250
251
}

mb0's avatar
Up.    
mb0 committed
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
__obj __unconsume32 (__obj s) {
  __LOCAL(blob, __RECORD_SELECT(s,___blob));
  __char* buf = blob->blob.blob;
  __word sz = blob->blob.sz;
  __LOCAL0(blobb);
    __BLOB_BEGIN(blobb);
    __BLOB_INIT(buf-4,sz+4);
    __BLOB_END(blobb);
  __LOCAL0(ss);
    __RECORD_BEGIN_UPDATE(ss,s);
    __RECORD_UPDATE(___blob,blobb);
    __RECORD_END_UPDATE(ss);
  __LOCAL0(a);
    __RECORD_BEGIN(a,2);
    __RECORD_ADD(___1,__UNIT);
    __RECORD_ADD(___2,ss);
    __RECORD_END(a,2);
  return (a);
}

mb0's avatar
mb0 committed
272
__obj __slice (__obj tok_, __obj offs_, __obj sz_) {
mb0's avatar
mb0 committed
273
274
275
276
277
278
279
280
  __word tok = tok_->bv.vec;
  __int offs = offs_->z.value;
  __int sz = sz_->z.value;
  __word x = ((tok >> offs) & ((1 << sz)-1));
  __LOCAL0(slice);
    __BV_BEGIN(slice,sz);
    __BV_INIT(x);
    __BV_END(slice,sz);
mb0's avatar
mb0 committed
281
  return (slice);
mb0's avatar
mb0 committed
282
283
284
}

__obj __halt (__obj env, __obj o) {
mb0's avatar
mb0 committed
285
  return (o);
mb0's avatar
mb0 committed
286
287
}

288
__obj __runWithState (__obj (*f)(__obj,__obj), __obj s) {
mb0's avatar
mb0 committed
289
290
291
292
293
294
295
296
  __LOCAL0(k);
    __LABEL_BEGIN(k);
    __LABEL_INIT(__halt);
    __LABEL_END(k);
  __LOCAL0(envK);
    __CLOSURE_BEGIN(envK,1)
    __CLOSURE_ADD(k);
    __CLOSURE_END(envK,1);
mb0's avatar
mb0 committed
297
  return (__FCALL(f,envK,s));
mb0's avatar
mb0 committed
298
299
}

300
__obj __eval (__obj (*f)(__obj,__obj), __char* blob, __word sz) {
mb0's avatar
mb0 committed
301
302
  __LOCAL0(b);
    __BLOB_BEGIN(b);
mb0's avatar
mb0 committed
303
    __BLOB_INIT(blob,sz);
mb0's avatar
mb0 committed
304
305
    __BLOB_END(b);
  __LOCAL0(s);
mb0's avatar
mb0 committed
306
    __RECORD_BEGIN(s,1);
mb0's avatar
mb0 committed
307
308
309
310
311
    __RECORD_ADD(___blob,b);
    __RECORD_END(s,1);
  return (__runWithState(f,s));
}

mb0's avatar
mb0 committed
312
/* Caller needs to reset the heap with `__resetHeap()` */
313
__word __decode (__obj (*f)(__obj,__obj), __char* blob, __word sz, __obj* insn) {
mb0's avatar
mb0 committed
314
315
316
317
318
319
320
321
  __obj o = __eval(f,blob,sz);
  if (___isNil(o)) {
    *insn = o;
    return (0);
  } else {
    __obj i = __RECORD_SELECT(o,___1);
    __obj s = __RECORD_SELECT(o,___2);
    __obj blobb = __RECORD_SELECT(s,___blob);
mb0's avatar
mb0 committed
322
    __word consumed = sz - blobb->blob.sz;
mb0's avatar
mb0 committed
323
324
325
326
327
    *insn = i;
    return (consumed);
  }
}

mb0's avatar
Foo.    
mb0 committed
328
329
330
331
332
333
334
335
336
337
__obj __cont (__obj env, __obj f) {
  __LOCAL(s,__CLOSURE_REF(env,1));
  __LOCAL0(k);
    __LABEL_BEGIN(k);
    __LABEL_INIT(__halt);
    __LABEL_END(k);
  __LOCAL0(envK);
    __CLOSURE_BEGIN(envK,1)
    __CLOSURE_ADD(k);
    __CLOSURE_END(envK,1);
mb0's avatar
mb0 committed
338
339
  __LOCAL(ff,__CLOSURE_REF(f,0));
  return (__INVOKE3(ff,f,envK,s));
mb0's avatar
Foo.    
mb0 committed
340
341
342
343
344
345
346
347
348
349
350
351
352
}

__obj __translate (__obj (*f)(__obj,__obj), __obj insn) {
  __LOCAL0(s);
    __RECORD_BEGIN(s,0);
    __RECORD_END(s,0);
  __LOCAL0(k);
    __LABEL_BEGIN(k);
    __LABEL_INIT(__cont);
    __LABEL_END(k);
  __LOCAL0(envK);
    __CLOSURE_BEGIN(envK,2)
    __CLOSURE_ADD(s);
mb0's avatar
mb0 committed
353
    __CLOSURE_ADD(k);
mb0's avatar
Foo.    
mb0 committed
354
    __CLOSURE_END(envK,2);
mb0's avatar
mb0 committed
355
356
  __LOCAL(ss, __FCALL(f,envK,insn));
  return (__RECORD_SELECT(ss,___1));
mb0's avatar
Foo.    
mb0 committed
357
358
}

mb0's avatar
mb0 committed
359
360
361
362
363
364
365
366
367
368
369
370
const __char* __fieldName (__word i) {
  static __char* unknown = (__char*)"<unknown>";
  if (i < __NFIELDS)
     return ((const __char*)__fieldNames[i]);
  return (unknown);
}

const __char* __tagName (__word i) {
  static __char* unknown = (__char*)"<unknown>";
  if (i < __NTAGS)
     return ((const __char*)__tagNames[i]);
  return (unknown);
mb0's avatar
mb0 committed
371
372
373
374
}

__obj __print (__obj o) {
  switch (__TAG(o)) {
375
    case __CLOSURE:
mb0's avatar
mb0 committed
376
      printf("{tag=__CLOSURE,sz=%zu,env=..}",o->closure.sz);
377
378
      break;
    case __INT:
mb0's avatar
mb0 committed
379
      printf("{tag=__INT,value=%ld}", o->z.value);
380
      break;
mb0's avatar
mb0 committed
381
382
383
384
385
386
387
388
389
    case __TAGGED: {
      __word tag = o->tagged.tag;
      if (tag < __NTAGS)
        printf("{tag=%s,",__tagName(tag));
      else
        printf("{tag=<unknown:%lu>,",tag);
      printf("payload=");
      __print(o->tagged.payload);
      printf("}");
mb0's avatar
mb0 committed
390
      break;
mb0's avatar
mb0 committed
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
    }
    case __RECORD: {
      printf("{tag=__RECORD,sz=%lu,", o->record.sz);
      int i;
      for (i=0;i<o->record.sz;i++) {
        __objref tagged = &o->record.fields[i];
        __word tag = tagged->tagged.tag;
        __obj payload = tagged->tagged.payload;
        if (tag < __NFIELDS)
          printf("%s=",__fieldName(tag));
        else
          printf("<unknown:%lu>=",tag);
        __print(payload);
        if (i < o->record.sz-1)
          printf(",");
      }
      printf("}");
408
      break;
mb0's avatar
mb0 committed
409
    }
410
    case __LABEL:
mb0's avatar
mb0 committed
411
      printf("{tag=__LABEL,f=%p}",o->label.f);
mb0's avatar
mb0 committed
412
413
      break;
    case __BLOB:
mb0's avatar
mb0 committed
414
      printf("{tag=__BLOB,sz=%lu,blob=%p}",o->blob.sz, o->blob.blob);
mb0's avatar
mb0 committed
415
416
      break;
    case __BV:
mb0's avatar
mb0 committed
417
      printf("{tag=__BV,sz=%lu,vec=%zx}", o->bv.sz, o->bv.vec);
mb0's avatar
mb0 committed
418
419
      break;
    case __NIL:
mb0's avatar
mb0 committed
420
      printf("{tag=__NIL}");
421
422
      break;
    default:
mb0's avatar
mb0 committed
423
      printf("{tag=<unknown>,..}");
424
   }
mb0's avatar
mb0 committed
425
   return (__UNIT);
426
427
}

mb0's avatar
mb0 committed
428
429
430
431
__obj __println (__obj o) {
  __print(o);
  printf("\n");
  return (__UNIT);
432
433
}

mb0's avatar
mb0 committed
434
435
__obj __traceln (const char* s, __obj o) {
  printf("TRACE:%s:",s);
mb0's avatar
mb0 committed
436
437
438
  return (__println(o));
}

439
440
441
442
443
444
445
446
__obj __isNil (__obj o) {
  switch (__TAG(o)) {
    case __NIL: return (__TRUE);
    default: return (__FALSE);
  }
}

int ___isNil (__obj o) {
mb0's avatar
mb0 committed
447
448
449
450
451
452
  switch (__TAG(o)) {
    case __NIL: return (1);
    default: return (0);
  }
}

453
__obj __printState () {
mb0's avatar
mb0 committed
454
455
456
457
458
  ptrdiff_t d = &heap[__RT_HEAP_SIZE] - hp;
  int n = d / sizeof(__unwrapped_obj);
  int used = n*100/__RT_HEAP_SIZE;
  printf("heap: %p, hp: %p, size: %u, used: %d (%d%%), obj-size: %zu\n",
    &heap[0], hp, __RT_HEAP_SIZE, n, used, sizeof(__unwrapped_obj));
459
  return (__UNIT);
mb0's avatar
mb0 committed
460
}
461

mb0's avatar
mb0 committed
462

mb0's avatar
mb0 committed
463
464
#ifdef WITHMAIN

mb0's avatar
mb0 committed
465
466
467
468
469
470
471
472
473
474
475
int main (int argc, char** argv) {
  __char blob001[15] = {0x67,0xF3,0x45,0x0F,0x7E,0xD1};
  __char blob002[15] = {0xF3,0x67,0x45,0x0F,0x7E,0xD1};
  __char blob003[15] = {0x67,0x45,0xF3,0x0F,0x7E,0xD1};
  __char blob004[15] = {0xF3,0x45,0x67,0x0F,0x7E,0xD1};
  //__char blob005[15] = {67C4E1F97EC8};
  //__char blob006[15] = {C4E1F9677EC8};
  __char blob007[15] = {0x67,0x45,0xF3,0x0F,0x7E,0x11};
  //__char blob008[15] = {C4E1F97EC8};
  __word sz = 15;

476
477
478
479
480
  decode(blob001, sz);
  decode(blob002, sz);
  decode(blob003, sz);
  decode(blob004, sz);
  decode(blob007, sz);
mb0's avatar
mb0 committed
481
482

  return (1); 
483
}
mb0's avatar
mb0 committed
484

mb0's avatar
mb0 committed
485
486
#endif

mb0's avatar
mb0 committed
487
@functions@
488