/
idris_rts.h
142 lines (107 loc) · 3.22 KB
/
idris_rts.h
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
#ifndef _IDRISRTS_H
#define _IDRISRTS_H
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <unistd.h>
#include <stdarg.h>
// Closures
typedef enum {
CON, INT, BIGINT, FLOAT, STRING, UNIT, PTR, FWD
} ClosureType;
typedef struct {
int tag;
int arity;
void* args;
} con;
typedef struct {
ClosureType ty;
union {
con c;
int i;
double f;
char* str;
void* ptr;
} info;
} Closure;
typedef Closure* VAL;
typedef struct {
VAL* valstack;
int* intstack;
double* floatstack;
VAL* valstack_top;
VAL* valstack_base;
int* intstack_ptr;
double* floatstack_ptr;
char* heap;
char* oldheap;
char* heap_next;
char* heap_end;
int stack_max;
size_t heap_size;
size_t heap_growth;
int allocations;
int collections;
VAL ret;
} VM;
VM* init_vm(int stack_size, size_t heap_size);
// Functions all take a pointer to their VM, and previous stack base,
// and return nothing.
typedef void(*func)(VM*, VAL*);
// Register access
#define RVAL (vm->ret)
#define LOC(x) (*(vm->valstack_base + (x)))
#define TOP(x) (*(vm->valstack_top + (x)))
// Retrieving values
#define GETSTR(x) (((VAL)(x))->info.str)
#define GETPTR(x) (((VAL)(x))->info.ptr)
#define GETFLOAT(x) (((VAL)(x))->info.f)
#define TAG(x) (ISINT(x) ? (-1) : ( (x)->ty == CON ? (x)->info.c.tag : (-1)) )
// Integers, floats and operators
typedef intptr_t i_int;
#define MKINT(x) ((void*)((x)<<1)+1)
#define GETINT(x) ((i_int)(x)>>1)
#define ISINT(x) ((((i_int)x)&1) == 1)
#define INTOP(op,x,y) MKINT((i_int)((((i_int)x)>>1) op (((i_int)y)>>1)))
#define FLOATOP(op,x,y) MKFLOAT(((GETFLOAT(x)) op (GETFLOAT(y))))
#define FLOATBOP(op,x,y) MKINT((i_int)(((GETFLOAT(x)) op (GETFLOAT(y)))))
#define ADD(x,y) (void*)(((i_int)x)+(((i_int)y)-1))
#define MULT(x,y) (MKINT((((i_int)x)>>1) * (((i_int)y)>>1)))
// Stack management
#define INITFRAME VAL* myoldbase
#define REBASE vm->valstack_base = oldbase
#define RESERVE(x)
#define ADDTOP(x) vm->valstack_top += (x)
#define TOPBASE(x) vm->valstack_top = vm->valstack_base + (x)
#define BASETOP(x) vm->valstack_base = vm->valstack_top + (x)
#define STOREOLD myoldbase = vm->valstack_base
#define CALL(f) f(vm, myoldbase);
#define TAILCALL(f) f(vm, oldbase);
// Creating new values (each value placed at the top of the stack)
VAL MKFLOAT(VM* vm, double val);
VAL MKSTR(VM* vm, char* str);
VAL MKPTR(VM* vm, void* ptr);
VAL MKCON(VM* vm, int tag, int arity, ...);
void PROJECT(VM* vm, VAL r, int loc, int arity);
void SLIDE(VM* vm, int args);
void* allocate(VM* vm, size_t size);
void* allocCon(VM* vm, int arity);
void dumpVal(VAL r);
// Casts
#define idris_castIntFloat(x) MKFLOAT(vm, (double)(GETINT(x)))
#define idris_castFloatInt(x) MKINT((i_int)(GETFLOAT(x)))
VAL idris_castIntStr(VM* vm, VAL i);
VAL idris_castStrInt(VM* vm, VAL i);
VAL idris_castFloatStr(VM* vm, VAL i);
VAL idris_castStrFloat(VM* vm, VAL i);
// String primitives
VAL idris_concat(VM* vm, VAL l, VAL r);
VAL idris_strlt(VM* vm, VAL l, VAL r);
VAL idris_streq(VM* vm, VAL l, VAL r);
VAL idris_strlen(VM* vm, VAL l);
VAL idris_readStr(VM* vm, FILE* h);
// Handle stack overflow.
// Just reports an error and exits.
void stackOverflow();
#include "idris_gmp.h"
#endif