// ingest a new character into a logical line, and return true
// if the logical line is complete and can be parsed
bool logical_line_ingest(logical_line* line, char c) {
switch (c) {
case '\n':
line->in_comment = false;
if (line->parens != 0) {
c = ' ';
break;
}
case '\0':
line->str[line->len] = '\0';
return true;
case ';':
line->in_comment = true;
return false;
case '(':
if (!line->in_comment) line->parens++;
break;
case ')':
if (!line->in_comment) line->parens--;
break;
default:
break;
}
if (line->in_comment) return false;
line->str[line->len++] = c;
if (line->len >= line->max_len)
line->str = GC_REALLOC(line->str, line->max_len *= 2);
return false;
}
static void ps_append(partial_string_t* ps, char ch){
if (ps->len == ps->ptr){
ps->len *= 2;
ps->ptr = GC_REALLOC(ps->ptr, ps->len);
}
ps->buf[ps->ptr] = ch;
ps->ptr++;
}
void* xrealloc(void *ptr, size_t s) {
ptr = GC_REALLOC(ptr, s);
if (!ptr) {
perror("realloc");
exit(1);
}
return ptr;
}
void kari_vec_push(kari_vec_t* v, void* obj)
{
if(v->count == v->capacity) {
v->capacity *= 2;
v->entries = (void**)GC_REALLOC(v->entries, sizeof(void*) * v->capacity);
}
v->entries[v->count++] = obj;
}
void TokenAddCharacter(Token *tok, Character *ch)
{
assert (ch != NULL);
tok->chars = GC_REALLOC(tok->chars, (tok->nchars + 1) * sizeof(Character));
tok->chars[tok->nchars] = *ch;
tok->chars[tok->nchars].x = tok->width;
tok->width += ch->width;
tok->nchars++;
}
/*
* Allocate more memory for the given pointer.
* The reallocated pointer keeps the same properties (e.g. atomic or not, collectable or not).
* The extra allocated memory is zeroed.
* The allocated object is itself collectable.
* Raise an exception when no-more-memory.
*/
void* GE_recalloc(void* p, size_t old_nelem, size_t new_nelem, size_t elsize)
{
void* new_p;
#ifdef EIF_BOEHM_GC
new_p = GE_null(GC_REALLOC(p, new_nelem * elsize));
#else /* No GC */
new_p = GE_null(realloc(p, new_nelem * elsize));
#endif
memset(((char*) new_p) + (old_nelem * elsize), 0, (new_nelem - old_nelem) * elsize);
return new_p;
}
void* kari_vec_pop(kari_vec_t* v)
{
if(v->count == 0) {
return NULL;
}
if(v->count == v->capacity / 2) {
v->capacity /= 2;
v->entries = (void**)GC_REALLOC(v->entries, sizeof(void*) * v->capacity);
}
return v->entries[--v->count];
}
void kari_vec_remove(kari_vec_t* v, size_t offset)
{
if(offset >= v->count) {
return;
}
if(offset + 1 < v->count) {
memmove(&v->entries[offset], &v->entries[offset + 1], v->count - offset);
}
v->count--;
if(v->count == v->capacity / 2) {
v->capacity /= 2;
v->entries = (void**)GC_REALLOC(v->entries, sizeof(void*) * v->capacity);
}
}
// A combination of sprintf and strcat, catf safely appends formatted
// strings to the end of the buffer, enlarging the buffer as needed
inline static int catf(char* fmt, ...) {
va_list args;
va_start(args, fmt);
char* new_part;
vasprintf(&new_part, fmt, args);
va_end(args);
size_t extra_len = strlen(new_part);
if (buf_index + extra_len >= buf_len) {
buf = GC_REALLOC(buf, buf_len = (buf_index + extra_len) * 2);
}
memcpy(buf + buf_index, new_part, extra_len + 1);
free(new_part);
return buf_index += extra_len;
}
int main()
{
int i;
GC_INIT(); /* Optional on Linux/X86; see below. */
for (i = 0; i < 10000000; ++i)
{
int **p = (int **) GC_MALLOC(sizeof(int *));
int *q = (int *) GC_MALLOC_ATOMIC(sizeof(int));
assert(*p == 0);
*p = (int *) GC_REALLOC(q, 2 * sizeof(int));
if (i % 100000 == 0)
printf("Heap size = %d\n", GC_get_heap_size());
}
return 0;
}
void VisualLineAddToken(VisualLine *line, Token *tok)
{
assert (tok != NULL);
line->tokens = GC_REALLOC(line->tokens, (line->ntokens + 1) * sizeof(Token));
line->tokens[line->ntokens] = *tok;
short x = 0;
if (line->ntokens > 0) {
x = line->tokens[line->ntokens - 1].x + line->tokens[line->ntokens - 1].width;
}
line->tokens[line->ntokens].x = x;
if (line->tokens[line->ntokens].chars[0].utf8[0] == '\t') {
short tab_width = YFontTextWidth(font, " ", 1) * 8;
line->tokens[line->ntokens].width = (x / tab_width + 1) * tab_width - x;
}
line->ntokens++;
}
static void build_args(dfsch_object_t* list, int* pargc, char*** pargv){
int alloc = 16;
char** argv = GC_MALLOC(sizeof(char*) * alloc);
int argc = 0;
while (DFSCH_PAIR_P(list)){
if (alloc <= argc){
alloc *= 2;
argv = GC_REALLOC(argv, sizeof(char*) * alloc);
}
argv[argc] = convert_arg(DFSCH_FAST_CAR(list));
argc++;
list = DFSCH_FAST_CDR(list);
}
*pargc = argc;
*pargv = argv;
}
Token *CharactersToTokens(Character text[], size_t nchars, size_t *ntokens_return)
{
assert(text != NULL);
puts("CharactersToTokens...");
// nchars がトークン数の上限である。
Token *res = GC_MALLOC(sizeof(Token) * nchars);
size_t ntokens = 0;
Character *p = text;
while (p < text + nchars) {
p = Tokenize(p, &res[ntokens++]);
}
puts("Done");
res = GC_REALLOC(res, sizeof(Token) * ntokens);
*ntokens_return = ntokens;
return res;
}
// 文字列を Character レコードの配列に変換する。
// 個々の Character の x 座標は 0 に設定される。
Character *StringToCharacters(const char *text, size_t length, size_t *nchars_return)
{
const char *p;
// 上限値で確保する。
Character *ret = GC_MALLOC(sizeof(Character) * (length + 1));
Character *q = ret;
printf("StringToCharacters... %d bytes\n", (int) length);
for (p = text; p < text + length; p = Utf8AdvanceChar(p)) {
CharacterInitialize(q++, 0, p, Utf8CharBytes(p));
}
*q++ = EOF_CHARACTER;
*nchars_return = q - ret;
// 無駄な部分を解放する。
ret = GC_REALLOC(ret, sizeof(Character) * (q - ret));
puts("Done");
return ret;
}
dfsch_strbuf_t* dfsch_port_readline(dfsch_object_t* port){
int ch;
char* buf;
size_t buflen;
size_t len;
buflen = 128;
len = 0;
buf = GC_MALLOC_ATOMIC(buflen);
dfsch_port_batch_read_start(port);
DFSCH_UNWIND {
while (1){
ch = dfsch_port_batch_read(port);
if (ch == -1){
break;
}
if (buflen <= len){
buflen *= 2;
buf = GC_REALLOC(buf, buflen);
}
buf[len] = ch;
len++;
if (ch == '\n'){
break;
}
}
} DFSCH_PROTECT {
dfsch_port_batch_read_end(port);
} DFSCH_PROTECT_END;
if (len == 0){
return NULL;
}
return dfsch_strbuf_create(buf, len);
}
char* dfsch_vsaprintf(char* format, va_list ap){
char* buf = GC_MALLOC_ATOMIC(128);
int r;
va_list ap2;
va_copy(ap2, ap);
r=vsnprintf(buf, 128, format, ap2);
va_end(ap2);
if (r<0){
return NULL;
}
if (r>=128){
buf = GC_REALLOC(buf, r+1);
r = vsnprintf(buf, r+1, format, ap);
if (r<0){
return NULL;
}
}
return buf;
}
static VisualLine *CreateLines(Token *tokens, size_t ntokens, const PageInfo *page, size_t *nlines_return)
{
VisualLine *lines = NULL;
size_t nlines = 0;
Token *tok = tokens;
// InspectPageInfo(page);
VisualLine *line;
do {
lines = GC_REALLOC(lines, (nlines + 1) * sizeof(VisualLine));
tok = FillLine(&line, tok, page);
SetContextualCharacterWidths(line);
if (!LastLineOfParagraph(line))
JustifyLine(line, page);
lines[nlines] = *line;
nlines++;
} while (tok < tokens + ntokens);
*nlines_return = nlines;
return lines;
}
char* kari_inspect(kari_value_t* value)
{
size_t s_len, s_cap, i, tmp_size;
char *s, *tmp_s;
switch(K_TYPE_OF(value)) {
case KARI_NIL:
return "(nil)";
case KARI_STRING:
s_len = 0;
s_cap = 16;
s = (char*)GC_MALLOC(s_cap);
s[s_len++] = '"';
for(i = 0; i < ((kari_string_t*)value)->len; i++) {
if(s_len + 2 >= s_cap) {
s_cap *= 2;
s = (char*)GC_REALLOC(s, s_cap);
}
if(((kari_string_t*)value)->str[i] == '"' || ((kari_string_t*)value)->str[i] == '\\') {
s[s_len++] = '\\';
}
s[s_len++] = ((kari_string_t*)value)->str[i];
}
if(s_len + 2 >= s_cap) {
s = (char*)GC_REALLOC(s, s_cap + 2);
}
s[s_len++] = '"';
s[s_len++] = 0;
return s;
case KARI_NUMBER:
s = (char*)GC_MALLOC(32);
sprintf(s, "%f", K_GET_NUMBER(value));
for(i = strlen(s) - 1; s[i] == '0' || s[i] == '.'; i--) {
if(s[i] == '.') {
s[i] = 0;
break;
} else {
s[i] = 0;
}
}
if(s[0] == 0) {
s[0] = '0';
}
return s;
case KARI_NATIVE_FUNCTION:
s = (char*)GC_MALLOC(64);
sprintf(s, "(native-function:%p)", (void*)(size_t)((kari_native_function_t*)value)->call);
return s;
case KARI_FUNCTION:
return "(function)";
case KARI_TRUE:
return "(true)";
case KARI_FALSE:
return "(false)";
case KARI_ARRAY:
s_len = 0;
s_cap = 16;
s = (char*)GC_MALLOC(s_cap);
s[s_len++] = '[';
for(i = 0; i < ((kari_array_t*)value)->items->count; i++) {
if(i != 0) {
if(s_len + 2 > s_cap) {
s_cap *= 2;
s = (char*)GC_REALLOC(s, s_cap);
}
s[s_len++] = ',';
s[s_len++] = ' ';
}
if(K_TYPE_OF((kari_value_t*)((kari_array_t*)value)->items->entries[i]) == KARI_ARRAY) {
tmp_s = "(array)";
} else if(K_TYPE_OF((kari_value_t*)((kari_array_t*)value)->items->entries[i]) == KARI_ARRAY) {
tmp_s = "(dict)";
} else {
tmp_s = kari_inspect((kari_value_t*)((kari_array_t*)value)->items->entries[i]);
}
tmp_size = strlen(tmp_s);
while(s_len + tmp_size > s_cap) {
s_cap *= 2;
s = (char*)GC_REALLOC(s, s_cap);
}
memcpy(s + s_len, tmp_s, tmp_size);
s_len += tmp_size;
}
if(s_len + 2 > s_cap) {
s_cap *= 2;
s = (char*)GC_REALLOC(s, s_cap);
}
s[s_len++] = ']';
s[s_len++] = 0;
return s;
case KARI_DICT:
s_len = 0;
s_cap = 16;
s = (char*)GC_MALLOC(s_cap);
s[s_len++] = '{';
s[s_len++] = ' ';
for(i = 0; i < ((kari_dict_val_t*)value)->items->keys->count; i++) {
if(i != 0) {
if(s_len + 5 > s_cap) {
s_cap *= 2;
s = (char*)GC_REALLOC(s, s_cap);
}
s[s_len++] = ',';
s[s_len++] = ' ';
}
tmp_size = strlen((char*)((kari_dict_val_t*)value)->items->keys->entries[i]);
while(s_len + tmp_size + 5 > s_cap) {
s_cap *= 2;
s = (char*)GC_REALLOC(s, s_cap);
}
memcpy(s + s_len, (char*)((kari_dict_val_t*)value)->items->keys->entries[i], tmp_size);
s_len += tmp_size;
s[s_len++] = ':';
s[s_len++] = ' ';
if(K_TYPE_OF((kari_value_t*)kari_dict_find_value(((kari_dict_val_t*)value)->items,
(char*)((kari_dict_val_t*)value)->items->keys->entries[i])) == KARI_ARRAY) {
tmp_s = "(array)";
} else if(K_TYPE_OF((kari_value_t*)kari_dict_find_value(((kari_dict_val_t*)value)->items,
(char*)((kari_dict_val_t*)value)->items->keys->entries[i])) == KARI_DICT) {
tmp_s = "(dict)";
} else {
tmp_s = kari_inspect((kari_value_t*)kari_dict_find_value(((kari_dict_val_t*)value)->items,
(char*)((kari_dict_val_t*)value)->items->keys->entries[i]));
}
tmp_size = strlen(tmp_s);
while(s_len + tmp_size + 3 > s_cap) {
s_cap *= 2;
s = (char*)GC_REALLOC(s, s_cap);
}
memcpy(s + s_len, tmp_s, tmp_size);
s_len += tmp_size;
}
s[s_len++] = ' ';
s[s_len++] = '}';
s[s_len] = 0;
return s;
case KARI_DATA:
s = (char*)GC_MALLOC(64);
sprintf(s, "(data:%p)", (void*)(size_t)((kari_data_t*)value)->ptr);
return s;
default:
return "(unknown type)";
}
}
void* kari_realloc(void* ptr, size_t len)
{
return GC_REALLOC(ptr, len);
}
void *stm_realloc(void* ptr, size_t size)
{
return GC_REALLOC(ptr, size);
}
void *Allocator_realloc(void *mem, int new_size)
{
return GC_REALLOC(mem, new_size);
}
/*
* Repeatedly reverse lists built out of very different sized cons cells.
* Check that we didn't lose anything.
*/
void *GC_CALLBACK reverse_test_inner(void *data)
{
int i;
sexpr b;
sexpr c;
sexpr d;
sexpr e;
sexpr *f, *g, *h;
if (data == 0) {
/* This stack frame is not guaranteed to be scanned. */
return GC_call_with_gc_active(reverse_test_inner, (void*)(word)1);
}
# if /*defined(MSWIN32) ||*/ defined(MACOS)
/* Win32S only allows 128K stacks */
# define BIG 1000
# elif defined(PCR)
/* PCR default stack is 100K. Stack frames are up to 120 bytes. */
# define BIG 700
# elif defined(MSWINCE) || defined(RTEMS)
/* WinCE only allows 64K stacks */
# define BIG 500
# elif defined(OSF1)
/* OSF has limited stack space by default, and large frames. */
# define BIG 200
# elif defined(__MACH__) && defined(__ppc64__)
# define BIG 2500
# else
# define BIG 4500
# endif
A.dummy = 17;
a = ints(1, 49);
b = ints(1, 50);
c = ints(1, BIG);
d = uncollectable_ints(1, 100);
e = uncollectable_ints(1, 1);
/* Check that realloc updates object descriptors correctly */
collectable_count++;
f = (sexpr *)GC_MALLOC(4 * sizeof(sexpr));
realloc_count++;
f = (sexpr *)GC_REALLOC((void *)f, 6 * sizeof(sexpr));
f[5] = ints(1,17);
collectable_count++;
g = (sexpr *)GC_MALLOC(513 * sizeof(sexpr));
realloc_count++;
g = (sexpr *)GC_REALLOC((void *)g, 800 * sizeof(sexpr));
g[799] = ints(1,18);
collectable_count++;
h = (sexpr *)GC_MALLOC(1025 * sizeof(sexpr));
realloc_count++;
h = (sexpr *)GC_REALLOC((void *)h, 2000 * sizeof(sexpr));
# ifdef GC_GCJ_SUPPORT
h[1999] = gcj_ints(1,200);
for (i = 0; i < 51; ++i)
h[1999] = gcj_reverse(h[1999]);
/* Leave it as the reveresed list for now. */
# else
h[1999] = ints(1,200);
# endif
/* Try to force some collections and reuse of small list elements */
for (i = 0; i < 10; i++) {
(void)ints(1, BIG);
}
/* Superficially test interior pointer recognition on stack */
c = (sexpr)((char *)c + sizeof(char *));
d = (sexpr)((char *)d + sizeof(char *));
GC_FREE((void *)e);
check_ints(b,1,50);
check_ints(a,1,49);
for (i = 0; i < 50; i++) {
check_ints(b,1,50);
b = reverse(reverse(b));
}
check_ints(b,1,50);
check_ints(a,1,49);
for (i = 0; i < 60; i++) {
# if defined(GC_PTHREADS) || defined(GC_WIN32_THREADS)
if (i % 10 == 0) fork_a_thread();
# endif
/* This maintains the invariant that a always points to a list of */
/* 49 integers. Thus this is thread safe without locks, */
/* assuming atomic pointer assignments. */
a = reverse(reverse(a));
# if !defined(AT_END) && !defined(THREADS)
/* This is not thread safe, since realloc explicitly deallocates */
if (i & 1) {
a = (sexpr)GC_REALLOC((void *)a, 500);
} else {
a = (sexpr)GC_REALLOC((void *)a, 8200);
}
# endif
}
check_ints(a,1,49);
check_ints(b,1,50);
/* Restore c and d values. */
c = (sexpr)((char *)c - sizeof(char *));
d = (sexpr)((char *)d - sizeof(char *));
check_ints(c,1,BIG);
check_uncollectable_ints(d, 1, 100);
check_ints(f[5], 1,17);
check_ints(g[799], 1,18);
# ifdef GC_GCJ_SUPPORT
h[1999] = gcj_reverse(h[1999]);
# endif
check_ints(h[1999], 1,200);
# ifndef THREADS
a = 0;
# endif
*(volatile void **)&b = 0;
*(volatile void **)&c = 0;
return 0;
}
int main(int argc, char **argv)
{
FILE *pslf;
unsigned char *psl;
size_t len, rd, i;
size_t slen, stype, stl;
struct PlofObject *context;
struct PlofReturn ret;
char *wdir, *wfil;
GC_INIT();
if (argc != 2) {
fprintf(stderr, "Use: psli <file>\n");
return 1;
}
/* get our search path */
if (whereAmI(argv[0], &wdir, &wfil)) {
plofIncludePaths = GC_MALLOC(3 * sizeof(unsigned char *));
/* /../share/plof_include/ */
plofIncludePaths[0] = GC_MALLOC_ATOMIC(strlen(wdir) + 24);
sprintf((char *) plofIncludePaths[0], "%s/../share/plof_include/", wdir);
/* /../../plof_include/ (for running from src/) */
plofIncludePaths[1] = GC_MALLOC_ATOMIC(strlen(wdir) + 21);
sprintf((char *) plofIncludePaths[1], "%s/../../plof_include/", wdir);
plofIncludePaths[2] = NULL;
/* FIXME: should support -I eventually */
} else {
plofIncludePaths[0] = NULL;
}
/* open the file */
pslf = fopen(argv[1], "rb");
if (pslf == NULL) {
perror(argv[1]);
return 1;
}
/* preallocate the buffer */
psl = GC_MALLOC_ATOMIC(BUFSTEP);
len = 0;
/* now start reading */
while ((rd = fread(psl + len, 1, BUFSTEP, pslf))) {
len += rd;
if (rd < BUFSTEP) break;
/* allocate more */
psl = GC_REALLOC(psl, len + BUFSTEP);
}
fclose(pslf);
/* FIXME: bounds checking */
/* Go section-by-section */
for (i = 8; i < len;) {
/* section length */
i += pslBignumToInt(psl + i, (size_t *) &slen);
/* section type */
stl = pslBignumToInt(psl + i, (size_t *) &stype);
/* if it's program data, we found it */
if (stype == 0) {
i += stl;
break;
} else {
/* skip this section */
i += slen;
}
}
/* make sure we found it */
if (i >= len) {
fprintf(stderr, "No program data!\n");
return 1;
}
/* Initialize null and global */
plofNull = newPlofObject();
plofNull->parent = plofNull;
plofGlobal = newPlofObject();
plofGlobal->parent = plofGlobal;
/* And the context */
context = newPlofObject();
context->parent = plofNull;
/* Now interp */
interpretPSL(context, plofNull, NULL, slen - stl, psl + i, 0, 1);
ret = interpretPSL(context, plofNull, NULL, slen - stl, psl + i, 0, 0);
if (ret.isThrown) {
fprintf(stderr, "PSL threw up!\n");
return 1;
}
return 0;
}
