reference-counted dynamic tag-union objects

M

mijoryx

Hello all.

A few weeks ago I received very useful guidance
on the subject of garbage-collection for a programming language
interpreter. Well here's the
result for scrutiny and critique.

What horribly stupid things have I overlooked?
Am I trying too much cleverness with macros?

/* object.h
global constants
object structures and typedefs
*/

//#include <ctype.h>
//#include <float.h>
//#include <math.h>
//#include <stdarg.h>
//#include <stdbool.h>
//#include <stdio.h>
//#include <stdlib.h>
//#include <string.h>

//limits
#define MAXNAMES 1000
#define MAXTOKEN 256
#define OSSIZE 500
#define ESSIZE 250
#define DSSIZE 20

//postscript inline
#define O(x) O ## x
#define ps(x) O(x)();
#define ps2(x,y) ps(x) ps(y)
#define ps3(x,y,z) ps2(x,y) ps(z)
#define ps4(a,b,c,d) ps3(a,b,c) ps(d)
#define ps5(a,b,c,d,e) ps4(a,b,c,d) ps(e)
#define ps6(a,b,c,d,e,f) ps5(a,b,c,d,e) ps(f)
#define ps7(a,b,c,d,e,f,g) ps6(a,b,c,d,e,f) ps(g)
#define ps8(a,b,c,d,e,f,g,h) ps7(a,b,c,d,e,f,g) ps(h)
//eg.
//ps8(dup,exch,array,astore,def,dict,currentpoint,matrix)

/* Objects */

#define Types \
X(null, int dummy) \
X(mark, int dummy2) \
X(boolean, bool b) \
X(integer, int i) \
X(real, float f) \
X(name, int n) \
X(string, String *s) \
X(array, Array *a) \
X(dict, Dict *d) \
X(operator, Operator op) \
X(file, FILE *file) \
X(font, void *font) \
X(packedarray, void *pa) \
X(save, void *save) \


struct s_operator {
char *name;
void (*fp)();
};

typedef struct s_object Object;
typedef struct s_string String;
typedef struct s_array Array;
typedef struct s_dict Dict;
typedef struct s_operator Operator;
struct s_object {
#define X(a, b) a ## type ,
enum e_type { Types } type;
#undef X
unsigned char flags;
#define READ 1
#define WRITE 2
#define EXEC 4
#define COMP 8
#define X(a, b) b;
union { Types } u;
#undef X
};

struct s_string {
int ref;
size_t length;
int offset;
char *s; };

struct s_array {
int ref;
size_t length;
int offset;
struct s_array *copyof;
Object *a; };

struct s_pair { Object key, value; };
struct s_dict {
int ref;
size_t length;
size_t maxlength;
struct s_pair *p; };

// Singular Objects
extern Object null;
extern Object mark;

// exported functions
int error (char *fmt, ...);
Object boolean (char b);
Object integer (int i);
Object real (float f);

extern char *names[];
//int nameslen;
Object name (char *s);

Object stringn (int n);
Object string (char *s);
void kill_string (String *s);
void inc_string (String *s);

Object array (int n);
void kill_array (Array *a);
void inc_array (Array *a);
Object car (Array *a);
Array * cdr (Array *a);

Object dict (int n);
int eq (Object a, Object b);
struct
s_pair * lookup (Dict *d, Object key);
bool define (Dict *d, Object key, Object value);
void kill_dict (Dict *d);
void inc_dict (Dict *d);

void kill (Object *o);
void inc (Object *o);

Object executable (Object o);
Object operator (char *name, void (*fp)());

/* eof: object.h */

/* object.c
error function (to avoid a main.h or misc.c)
object allocators
and storage for singular objects null and mark
*/

#include <float.h> //FLT_EPSILON
#include <math.h> //fabsf
#include <stdarg.h> //...
#include <stdbool.h> //true false
#include <stdio.h> //vfprintf
#include <stdlib.h> //exit malloc free
#include <string.h> //strcmp strdup
#include "object.h"

int error(char *fmt, ...) {
va_list argptr;
va_start( argptr, fmt );
(void)vfprintf(stderr, fmt, argptr);
(void)fputc('\n',stderr);
va_end(argptr);
exit(EXIT_FAILURE);
}

Object null = { .type = nulltype, .flags = 0, .u.dummy = 0};
Object mark = { .type = marktype, .flags = 0, .u.dummy2 = 0};

/* Object Allocators and Convenience Functions */

Object boolean (char b) {
Object o = { .type = booleantype, .flags = 0, .u.b = b };
return o; }

Object integer (int i) {
Object o = { .type = integertype, .flags = 0, .u.i = i };
return o; }

Object real (float f) {
Object o = { .type = realtype, .flags = 0, .u.f = f };
return o; }


char *names[MAXNAMES];
int nameslen = 0;
Object name (char *s) {
Object o = { .type = nametype, .flags = 0, .u.dummy = 0 };
int i;
for (i=0; i<nameslen; i++) { //look
if (strcmp(s, names) == 0) { //found
o.u.n = i;
return o;
}
}
o.u.n = i; //new
names = strdup(s);
nameslen++;
return o;
}


Object stringn (int n) {
Object o = { .type = stringtype, .flags = COMP, .u.dummy = 0 };
(void)((o.u.s = (String *)malloc(sizeof *o.u.s))
|| error("VMerror in stringn"));
o.u.s->ref = 1;
o.u.s->length = (size_t)n;
o.u.s->offset = 0;
(void)((o.u.s->s = malloc((size_t)n+1))
|| error("VMerror in stringn"));
return o; }

Object string (char *s) {
Object o;
size_t n;
n = strlen(s);
o = stringn((int)n);
strncpy(o.u.s->s, s, n);
return o; }

void kill_string(String *s) {
if (--s->ref == 0) {
free(s->s);
free(s);
}
}

void inc_string(String *s) { s->ref++; }


Object array (int n) {
Object o = { .type = arraytype, .flags = COMP, .u.dummy = 0 };
(void)((o.u.a = (Array *)malloc(sizeof *o.u.a))
|| error("VMerror in array"));
o.u.a->ref = 1;
o.u.a->length = (size_t)n;
o.u.a->offset = 0;
o.u.a->copyof = NULL;
(void)((o.u.a->a = (Object *)calloc((size_t)n, sizeof o))
|| error("VMerror in array"));
return o; }

void kill_array(Array *a) {
if (--a->ref == 0) {
int i;
for (i=0; i < (int)a->length; i++) {
//kill elements
}
if(a->copyof) kill_array(a->copyof);
else free(a->a);
free(a);
}
}

void inc_array(Array *a) { a->ref++; }

Object car(Array *a) {
return a->a[a->offset];
}

Array *cdr(Array *a) {
Array *new;
(void)((new = (Array *)malloc(sizeof *new))
|| error("VMerror in cdr"));
new->ref = 1;
new->length = a->length - 1;
new->offset = a->offset + 1;
new->copyof = a;
new->a = a->a;
return new;
}



Object dict (int n) {
Object o = { .type = dicttype, .flags = COMP, .u.dummy = 0 };
(void)((o.u.d = (Dict *)malloc(sizeof *o.u.d))
|| error("VMerror in dict"));
o.u.d->ref = 1;
o.u.d->maxlength = (size_t)n;
o.u.d->length = 0;
(void)((o.u.d->p = (struct s_pair *)calloc((size_t)n,sizeof *o.u.d-
|| error("VMerror in dict"));
return o; }

int eq (Object a, Object b) {
if (a.type != b.type) { return false; }
switch(a.type) {
case nulltype:
case marktype: return true;
case booleantype: return a.u.b == b.u.b;
case nametype: //ints
case integertype: return a.u.i == b.u.i;
case realtype: return fabsf(a.u.f - b.u.f) > FLT_EPSILON;
case stringtype: //composites (pointers)
case arraytype:
case filetype:
case dicttype: return a.u.d == b.u.d;
case operatortype: return a.u.op.fp == b.u.op.fp;
default:
return false;
}
}

struct s_pair *lookup (Dict *d, Object key) {
struct s_pair *p = NULL;
int i;
for (i=0; i < (int)d->length; i++) {
if (eq(d->p.key,key)) {
p = &d->p;
break;
}
}
return p;
}

bool define(Dict *d, Object key, Object value) {
struct s_pair *p;
p = lookup(d, key);
if (p) {
p->value = value;
return true;
} else {
if (d->length >= d->maxlength) {
//error("dictfull in define");
return false;
}
p = &d->p[d->length++];
p->key = key;
p->value = value;
return true;
}
}

void kill_dict(Dict *d) {
if (--d->ref == 0) {
int i;
for (i=0; i < (int)d->length; i++) {
//kill elements
}
free(d->p);
free(d);
}
}

void inc_dict(Dict *d) { d->ref++; }


void kill(Object *o) {
if (o->flags & COMP ) { //if killable,
switch(o->type) { //kill whatever
#define X(a,b) case a ## type: kill_ ## a (o->u. b ); break;
X(string,s)
X(array,a)
X(dict,d)
#undef X
default: break;
}
}
}

void inc(Object *o) {
if (o->flags & COMP) {
switch(o->type) {
#define X(a,b) case a ## type: kill_ ## a (o->u. b ); break;
X(string,s)
X(array,a)
X(dict,d)
#undef X
default: break;
}
}
}

Object executable (Object o) { o.flags |= EXEC; return o; }

Object operator (char *name, void (*fp)()) {
Object o = { .type = operatortype, .flags = EXEC,
.u.op = { .name = name, .fp = fp } };
return o; }


/* object.c
error function (to avoid a main.h or misc.c)
object allocators
and storage for singular objects null and mark
*/

#include <float.h> //FLT_EPSILON
#include <math.h> //fabsf
#include <stdarg.h> //...
#include <stdbool.h> //true false
#include <stdio.h> //vfprintf
#include <stdlib.h> //exit malloc free
#include <string.h> //strcmp strdup
#include "object.h"

int error(char *fmt, ...) {
va_list argptr;
va_start( argptr, fmt );
(void)vfprintf(stderr, fmt, argptr);
(void)fputc('\n',stderr);
va_end(argptr);
exit(EXIT_FAILURE);
}

Object null = { .type = nulltype, .flags = 0, .u.dummy = 0};
Object mark = { .type = marktype, .flags = 0, .u.dummy2 = 0};

/* Object Allocators and Convenience Functions */

Object boolean (char b) {
Object o = { .type = booleantype, .flags = 0, .u.b = b };
return o; }

Object integer (int i) {
Object o = { .type = integertype, .flags = 0, .u.i = i };
return o; }

Object real (float f) {
Object o = { .type = realtype, .flags = 0, .u.f = f };
return o; }


char *names[MAXNAMES];
int nameslen = 0;
Object name (char *s) {
Object o = { .type = nametype, .flags = 0, .u.dummy = 0 };
int i;
for (i=0; i<nameslen; i++) { //look
if (strcmp(s, names) == 0) { //found
o.u.n = i;
return o;
}
}
o.u.n = i; //new
names = strdup(s);
nameslen++;
return o;
}


Object stringn (int n) {
Object o = { .type = stringtype, .flags = COMP, .u.dummy = 0 };
(void)((o.u.s = (String *)malloc(sizeof *o.u.s))
|| error("VMerror in stringn"));
o.u.s->ref = 1;
o.u.s->length = (size_t)n;
o.u.s->offset = 0;
(void)((o.u.s->s = malloc((size_t)n+1))
|| error("VMerror in stringn"));
return o; }

Object string (char *s) {
Object o;
size_t n;
n = strlen(s);
o = stringn((int)n);
strncpy(o.u.s->s, s, n);
return o; }

void kill_string(String *s) {
if (--s->ref == 0) {
free(s->s);
free(s);
}
}

void inc_string(String *s) { s->ref++; }


Object array (int n) {
Object o = { .type = arraytype, .flags = COMP, .u.dummy = 0 };
(void)((o.u.a = (Array *)malloc(sizeof *o.u.a))
|| error("VMerror in array"));
o.u.a->ref = 1;
o.u.a->length = (size_t)n;
o.u.a->offset = 0;
o.u.a->copyof = NULL;
(void)((o.u.a->a = (Object *)calloc((size_t)n, sizeof o))
|| error("VMerror in array"));
return o; }

void kill_array(Array *a) {
if (--a->ref == 0) {
int i;
for (i=0; i < (int)a->length; i++) {
//kill elements
}
if(a->copyof) kill_array(a->copyof);
else free(a->a);
free(a);
}
}

void inc_array(Array *a) { a->ref++; }

Object car(Array *a) {
return a->a[a->offset];
}

Array *cdr(Array *a) {
Array *new;
(void)((new = (Array *)malloc(sizeof *new))
|| error("VMerror in cdr"));
new->ref = 1;
new->length = a->length - 1;
new->offset = a->offset + 1;
new->copyof = a;
new->a = a->a;
return new;
}



Object dict (int n) {
Object o = { .type = dicttype, .flags = COMP, .u.dummy = 0 };
(void)((o.u.d = (Dict *)malloc(sizeof *o.u.d))
|| error("VMerror in dict"));
o.u.d->ref = 1;
o.u.d->maxlength = (size_t)n;
o.u.d->length = 0;
(void)((o.u.d->p = (struct s_pair *)calloc((size_t)n,sizeof *o.u.d-
|| error("VMerror in dict"));
return o; }

int eq (Object a, Object b) {
if (a.type != b.type) { return false; }
switch(a.type) {
case nulltype:
case marktype: return true;
case booleantype: return a.u.b == b.u.b;
case nametype: //ints
case integertype: return a.u.i == b.u.i;
case realtype: return fabsf(a.u.f - b.u.f) > FLT_EPSILON;
case stringtype: //composites (pointers)
case arraytype:
case filetype:
case dicttype: return a.u.d == b.u.d;
case operatortype: return a.u.op.fp == b.u.op.fp;
default:
return false;
}
}

struct s_pair *lookup (Dict *d, Object key) {
struct s_pair *p = NULL;
int i;
for (i=0; i < (int)d->length; i++) {
if (eq(d->p.key,key)) {
p = &d->p;
break;
}
}
return p;
}

bool define(Dict *d, Object key, Object value) {
struct s_pair *p;
p = lookup(d, key);
if (p) {
p->value = value;
return true;
} else {
if (d->length >= d->maxlength) {
//error("dictfull in define");
return false;
}
p = &d->p[d->length++];
p->key = key;
p->value = value;
return true;
}
}

void kill_dict(Dict *d) {
if (--d->ref == 0) {
int i;
for (i=0; i < (int)d->length; i++) {
//kill elements
}
free(d->p);
free(d);
}
}

void inc_dict(Dict *d) { d->ref++; }


void kill(Object *o) {
if (o->flags & COMP ) { //if killable,
switch(o->type) { //kill whatever
#define X(a,b) case a ## type: kill_ ## a (o->u. b ); break;
X(string,s)
X(array,a)
X(dict,d)
#undef X
default: break;
}
}
}

void inc(Object *o) {
if (o->flags & COMP) {
switch(o->type) {
#define X(a,b) case a ## type: kill_ ## a (o->u. b ); break;
X(string,s)
X(array,a)
X(dict,d)
#undef X
default: break;
}
}
}

Object executable (Object o) { o.flags |= EXEC; return o; }

Object operator (char *name, void (*fp)()) {
Object o = { .type = operatortype, .flags = EXEC,
.u.op = { .name = name, .fp = fp } };
return o; }

/* eof: object.c */

tia
luXer-ex-trog
 
C

CBFalconer

A few weeks ago I received very useful guidance on the subject
of garbage-collection for a programming language interpreter.
Well here's the result for scrutiny and critique.

What horribly stupid things have I overlooked?
Am I trying too much cleverness with macros?

.... snip 635 lines of junk ...

Yes.
 
M

mijoryx

... snip 635 lines of junk ...

Yes.

ouch.

I do apologise for double-pasting. In my defense, the
google-groups text window doesn't lend itself to double-
checking large blocks of text as a large block. I
should've pasted it together in a better editor first.

So clearly you don't like macros. Does the "junk"
appelation refer solely to that, or was there no
venom left for my malloc idiom?

I hesitated to send the complete program for fear of
receiving similar comments with larger line numbers.


l-x-t
 
M

mijoryx

It's occurred to me that there's a name collision
with kill. I've changed that to dec for better symmetry
with inc.
Is it worthwhile to boast that it passes gcc -Wall
and splint -weak?

l-x-t
 
B

Ben Bacarisse

It's occurred to me that there's a name collision
with kill. I've changed that to dec for better symmetry
with inc.
Is it worthwhile to boast that it passes gcc -Wall
and splint -weak?

I'd rather it was readable. After more than 25 years of reading C, I
find well-written C almost instantly understandable, but with macros
it is possible to write in a language of your own design. This seems
to be what you are doing.

If you are programming for yourself, then there is not much of a
problem, but then why post it? If you want people to read and
understand it, why write in that style?
 
M

mijoryx

I'd rather it was readable.  After more than 25 years of reading C, I
find well-written C almost instantly understandable, but with macros
it is possible to write in a language of your own design.  This seems
to be what you are doing.

Well, yes. But is that not the very purpose of
programming languages: to transform the domain space
so it more closely reflects the problem space?
If you are programming for yourself, then there is not much of a
problem, but then why post it?

To give specificity to a previously abstract conversation.


 If you want people to read and
understand it, why write in that style?

I'll own that it's idiosyncratic. That is my middle name
(after macro-expansion, of course). But is it really so
inscrutable?

The ps(...) macros merely decorate the names with a
capital O (for operator), and call the decorated names
as functions. This allows me to name my array-object
allocator "array", while the function implementing the
postscript operator of the same name is decorated:
"Oarray".

As for the X-macros, I took the idea from an article in
C/C++ Users Journal. It seems to help keep related
information together: directly tying the enum value
to it's associated union member.

Is there a better way?

l-x-t
 
K

Kaz Kylheku

... snip 635 lines of junk ...

Ah, so the way to get Chucky to actually snip something before adding his
useless one-liner is to make sure it's 1) topical and 2) he doesn't understand
it.
 
K

Kaz Kylheku

Hello all.

A few weeks ago I received very useful guidance
on the subject of garbage-collection for a programming language
interpreter. Well here's the
result for scrutiny and critique.

Look for Lisp500: Lisp implementation in 500 lines of C (plus a Lisp
source file).

http://www.modeemi.fi/~chery/lisp500/

This has a compiler to C too, not only an interpreter. :)
 
K

Kojak

Le Wed, 04 Mar 2009 16:37:57 GMT,
Bartc a écrit :
The C seems to be written horizontally. Does someone have one of
those formatting tools to find out how many lines this really is, if
laid out properly?

Passing through 'indent' without any option I get 2191 lines. And
with few options to beautify and render it more actual, I get 1968
lines. In short, we can count about 2 thousand lines.
 
M

mijoryx

Look for Lisp500: Lisp implementation in 500 lines of C (plus a Lisp
source file).

http://www.modeemi.fi/~chery/lisp500/

This has a compiler to C too, not only an interpreter. :)

Very cool. I think I see newt's-eyes and bat-wings.
That should help sweeten the broth (and add some chewy
bits). Now, can you use a cat to uproot a mandrake or does it have to
be a dog?

I don't anticipate my program achieving similar density
any time soon. But I do like functions to occupy as few
lines as possible (so I can see more on my tiny XO laptop
screen).

There's a good reference on faqs.org about PERL internals:
http://www.faqs.org/docs/perl5int/index.html

I'm digesting scalar variables at the moment.

l-x-t
 
B

Ben Bacarisse

Well, yes. But is that not the very purpose of
programming languages: to transform the domain space
so it more closely reflects the problem space?

Not in my view, no, but I think that discussion belongs in
comp.programming.

I'll own that it's idiosyncratic. That is my middle name
(after macro-expansion, of course). But is it really so
inscrutable?

Well you got me to read it!
The ps(...) macros merely decorate the names with a
capital O (for operator), and call the decorated names
as functions. This allows me to name my array-object
allocator "array", while the function implementing the
postscript operator of the same name is decorated:
"Oarray".

Well, that paragraph should be in the code as a comment. What I saw
was a bunch of commented-out #includes and a set of macros whose only
purpose was to turn

ps2(dup, exch)

into

Odup(); Oexch();

and which were then not used in the remaining code (so I could not see
a use-case for all that mess). At that point I gave up! I don't
think that ps2(dup, exch) is any closer to the problem domain than the
more obvious expanded version. In other words, the posted code starts
with the worst of it.
As for the X-macros, I took the idea from an article in
C/C++ Users Journal. It seems to help keep related
information together: directly tying the enum value
to it's associated union member.

Is there a better way?

Yes, that is not a bad idea, though if your project grows it might be
better to use a more flexible code-generating tool. The last
interpreted language I wrote had a small script took all the types and
operators and built from that the enums, unions and function
declarations. Of course, this is "more obscure" in some way because
it is not using the C pre-processor, but that is balanced by the
benefit of using a more powerful tool.

However...

| void inc(Object *o) {
| if (o->flags & COMP) {
| switch(o->type) {
| #define X(a,b) case a ## type: kill_ ## a (o->u. b ); break;
| X(string,s)
| X(array,a)
| X(dict,d)
| #undef X
| default: break;
| }
| }
| }

I am not sure of the benefit here. I'd write out the cases. If I had
all the types and union members in a table (because I was using Perl to
generate the code) then, yes, I'd automate this. BTW, is this code
correct? It calls kill_string etc. just like the 'kill' function but
it is called 'inc'.

Let me also through in another option. If you find yourself with a
lot of function that have a switch on the type, you can often turn
this round by having a function that calls another chosen from an
array, indexed by the type. I don't know enough about your program to
know if there is any benefit for you, but it is worth considering.
 
M

mijoryx

Not in my view, no, but I think that discussion belongs in
comp.programming.



Well you got me to read it!


Well, that paragraph should be in the code as a comment.  What I saw
was a bunch of commented-out #includes and a set of macros whose only
purpose was to turn

  ps2(dup, exch)

into

  Odup(); Oexch();

and which were then not used in the remaining code (so I could not see
a use-case for all that mess).  At that point I gave up!  I don't
think that ps2(dup, exch) is any closer to the problem domain than the
more obvious expanded version.  In other words, the posted code starts
with the worst of it.

Point taken. They belong in a different file and
should be commented.
Yes, that is not a bad idea, though if your project grows it might be
better to use a more flexible code-generating tool.  The last
interpreted language I wrote had a small script took all the types and
operators and built from that the enums, unions and function
declarations.  Of course, this is "more obscure" in some way because
it is not using the C pre-processor, but that is balanced by the
benefit of using a more powerful tool.

However...

|  void inc(Object *o) {
|          if (o->flags & COMP) {
|                  switch(o->type) {
|  #define X(a,b) case a ## type: kill_ ## a (o->u. b ); break;
|                          X(string,s)
|                          X(array,a)
|                          X(dict,d)
|  #undef X
|                          default: break;
|                  }
|          }
|  }

I am not sure of the benefit here.  I'd write out the cases.  If I had
all the types and union members in a table (because I was using Perl to
generate the code) then, yes, I'd automate this.  BTW, is this code
correct?  It calls kill_string etc. just like the 'kill' function but
it is called 'inc'.

Almost. The names I've settled on are "inc" (increment
the reference count) and "dec" (decrement the reference
count, destroying if zero).

And this was the specific section to which the "too much cleverness in
macros" question was meant to apply.
Congrats for teasing it out.

I think you're right that it doesn't offer much.
It actually makes the function 2 lines longer than
necessary. I tend to take new ideas and run with them.
(To a child with a hammer, every object is a nail).

Although I'm not using or including
the system function, kill, it seemed wiser to avoid
existing names. I've also changed the individual
functions from kill to dec :)%s/kill/dec/g),
so kill_string is now dec_string, etc.

Let me also through in another option.  If you find yourself with a
lot of function that have a switch on the type, you can often turn
this round by having a function that calls another chosen from an
array, indexed by the type.  I don't know enough about your program to
know if there is any benefit for you, but it is worth considering.

Yes. That may help. The obvious downside is a lot more
names floating around, but this may be offset by a
more robust and comprehensible polymorphism mechanism.
(I'll try not run wild with it.)

Another option, used by Crispin Goswell's postscript
interpreter, would be to hijack the dictionary mechanism
to associate the type-specific functions with the
type-names in the generalized functions.
But this makes more sense to me to put "outside" of
this module, ie. in the operator functions which the
Postscript standard describes as polymorphic.

Thanks for the second look.

luXer-ex-trog
 
M

mijoryx

Aha. The macros really did get in the way.
It obfuscated the bug that inc(Object *o)
was actually killing the object instead
of incrementing. Really Bad!

I'd like to take the time to apologise for
the mess of code I dumped in your laps.

From the artifacts of splitting the program
into modules (the commented-out #includes),
to the unused macros, to the unnecessary
macros that concealed a bug which would
have become obvious before typing it a third
time.

The fact anyone was willing and able to
wade through it in the attempt to be helpful
is a testiment to their kindness and keenness.

Here is the revised version, only the "real" X-macros
and defined constants remain:

/* object.h
global constants
object structures and typedefs
*/

//limits
#define MAXNAMES 1000
#define MAXTOKEN 256
#define OSSIZE 500
#define ESSIZE 250
#define DSSIZE 20

/* Objects */

#define Types \
X(null, int dummy) \
X(mark, int dummy2) \
X(boolean, bool b) \
X(integer, int i) \
X(real, float f) \
X(name, int n) \
X(string, String *s) \
X(array, Array *a) \
X(dict, Dict *d) \
X(operator, Operator op) \
X(file, FILE *file) \
X(font, void *font) \
X(packedarray, void *pa) \
X(save, void *save) \


struct s_operator {
char *name;
void (*fp)();
};

typedef struct s_object Object;
typedef struct s_string String;
typedef struct s_array Array;
typedef struct s_dict Dict;
typedef struct s_operator Operator;
struct s_object {
#define X(a, b) a ## type ,
enum e_type { Types } type;
#undef X
unsigned char flags;
#define READ 1
#define WRITE 2
#define EXEC 4
#define COMP 8
#define X(a, b) b;
union { Types } u;
#undef X
};

struct s_string {
int ref;
size_t length;
int offset;
struct s_string *copyof;
char *s; };

struct s_array {
int ref;
size_t length;
int offset;
struct s_array *copyof;
Object *a; };

struct s_pair { Object key, value; };
struct s_dict {
int ref;
size_t length;
size_t maxlength;
struct s_pair *p; };

// Singular Objects
extern Object null;
extern Object mark;

// exported functions
int error (char *fmt, ...);
Object boolean (char b);
Object integer (int i);
Object real (float f);

extern char *names[];
//int nameslen;
Object name (char *s);

Object stringn (int n);
Object string (char *s);
void dec_string (String *s);
void inc_string (String *s);
String * substring (String *s);

Object array (int n);
void dec_array (Array *a);
void inc_array (Array *a);
Object car (Array *a);
Array * cdr (Array *a);
Array * subarray (Array *a);

Object dict (int n);
int eq (Object a, Object b);
struct
s_pair * lookup (Dict *d, Object key);
bool define (Dict *d, Object key, Object value);
void dec_dict (Dict *d);
void inc_dict (Dict *d);

void dec (Object *o);
void inc (Object *o);

Object executable (Object o);
Object operator (char *name, void (*fp)());

/* eof: object.h */

/* object.c
error function (to avoid a main.h or misc.c)
object allocators
and storage for singular objects null and mark
*/

#include <float.h> //FLT_EPSILON
#include <math.h> //fabsf
#include <stdarg.h> //...
#include <stdbool.h> //true false
#include <stdio.h> //vfprintf
#include <stdlib.h> //exit malloc free
#include <string.h> //strcmp strdup
#include "object.h"

int error(char *fmt, ...) {
va_list argptr;
va_start( argptr, fmt );
(void)vfprintf(stderr, fmt, argptr);
(void)fputc('\n',stderr);
va_end(argptr);
exit(EXIT_FAILURE);
}

Object null = { .type = nulltype, .flags = 0, .u.dummy = 0};
Object mark = { .type = marktype, .flags = 0, .u.dummy2 = 0};

/* Object Allocators and Convenience Functions */

Object boolean (char b) {
Object o = { .type = booleantype, .flags = 0, .u.b = b };
return o; }

Object integer (int i) {
Object o = { .type = integertype, .flags = 0, .u.i = i };
return o; }

Object real (float f) {
Object o = { .type = realtype, .flags = 0, .u.f = f };
return o; }


char *names[MAXNAMES];
int nameslen = 0;
Object name (char *s) {
Object o = { .type = nametype, .flags = 0, .u.dummy = 0 };
int i;
for (i=0; i<nameslen; i++) { //look
if (strcmp(s, names) == 0) { //found
o.u.n = i;
return o;
}
}
o.u.n = i; //new
names = strdup(s);
nameslen++;
return o;
}


Object stringn (int n) {
Object o = { .type = stringtype, .flags = COMP, .u.dummy = 0 };
(void)((o.u.s = (String *)malloc(sizeof *o.u.s))
|| error("VMerror in stringn"));
o.u.s->ref = 1;
o.u.s->length = (size_t)n;
o.u.s->offset = 0;
o.u.s->copyof = NULL;
(void)((o.u.s->s = malloc((size_t)n+1))
|| error("VMerror in stringn"));
return o; }

Object string (char *s) {
Object o;
size_t n;
n = strlen(s);
o = stringn((int)n);
strncpy(o.u.s->s, s, n);
return o; }

void dec_string(String *s) {
if (--s->ref == 0) {
if (s->copyof) dec_string(s->copyof);
else free(s->s);
free(s);
}
}

void inc_string(String *s) { s->ref++; }

String *substring(String *s, int offset, int length) {
String *new;
if (offset+length > s->offset+s->length)
error("rangecheck in substring");
(void)((new = malloc(sizeof *new))
|| error("VMerror in substring"));
new->ref = 1;
new->offset = s->offset+offset;
new->length = length;
new->copyof = s;
new->s = s->s;
return new;
}


Object array (int n) {
Object o = { .type = arraytype, .flags = COMP, .u.dummy = 0 };
(void)((o.u.a = (Array *)malloc(sizeof *o.u.a))
|| error("VMerror in array"));
o.u.a->ref = 1;
o.u.a->length = (size_t)n;
o.u.a->offset = 0;
o.u.a->copyof = NULL;
(void)((o.u.a->a = (Object *)calloc((size_t)n, sizeof o))
|| error("VMerror in array"));
return o; }

void dec_array(Array *a) {
if (--a->ref == 0) {
int i;
for (i=0; i < (int)a->length; i++) {
//kill elements
}
if(a->copyof) dec_array(a->copyof);
else free(a->a);
free(a);
}
}

void inc_array(Array *a) { a->ref++; }

Array *subarray(Array *a, int offset, int length) {
Array *new;
if (offset+length > a->offset+a->length)
error("rangecheck in subarray");
(void)((new = malloc(sizeof *new))
|| error("VMerror in subarray"));
new->ref = 1;
new->offset = a->offset + offset;
new->length = length;
new->copyof = a;
new->a = a->a;
return new;
}

Object car(Array *a) {
return a->a[a->offset];
}

Array *cdr(Array *a) {
Array *new;
(void)((new = (Array *)malloc(sizeof *new))
|| error("VMerror in cdr"));
new->ref = 1;
new->offset = a->offset + 1;
new->length = a->length - 1;
new->copyof = a;
new->a = a->a;
return new;
}


Object dict (int n) {
Object o = { .type = dicttype, .flags = COMP, .u.dummy = 0 };
(void)((o.u.d = (Dict *)malloc(sizeof *o.u.d))
|| error("VMerror in dict"));
o.u.d->ref = 1;
o.u.d->maxlength = (size_t)n;
o.u.d->length = 0;
(void)((o.u.d->p = (struct s_pair *)calloc((size_t)n,sizeof *o.u.d-
|| error("VMerror in dict"));
return o; }

int eq (Object a, Object b) {
if (a.type != b.type) { return false; }
switch(a.type) {
case nulltype:
case marktype: return true;
case booleantype: return a.u.b == b.u.b;
case nametype: //ints
case integertype: return a.u.i == b.u.i;
case realtype: return fabsf(a.u.f - b.u.f) > FLT_EPSILON;
case stringtype: //composites (pointers)
case arraytype:
case filetype:
case dicttype: return a.u.d == b.u.d;
case operatortype: return a.u.op.fp == b.u.op.fp;
default:
return false;
}
}

struct s_pair *lookup (Dict *d, Object key) {
struct s_pair *p = NULL;
int i;
for (i=0; i < (int)d->length; i++) {
if (eq(d->p.key,key)) {
p = &d->p;
break;
}
}
return p;
}

bool define(Dict *d, Object key, Object value) {
struct s_pair *p;
p = lookup(d, key);
if (p) {
p->value = value;
return true;
} else {
if (d->length >= d->maxlength) {
//error("dictfull in define");
return false;
}
p = &d->p[d->length++];
p->key = key;
p->value = value;
return true;
}
}

void dec_dict(Dict *d) {
if (--d->ref == 0) {
int i;
for (i=0; i < (int)d->length; i++) {
//kill elements
}
free(d->p);
free(d);
}
}

void inc_dict(Dict *d) { d->ref++; }


void dec(Object *o) {
if (o->flags & COMP ) { //if Composite
switch(o->type) { //decrement the ref
case stringtype: dec_string(o->u.s); break;
case arraytype: dec_array(o->u.a); break;
case dicttype: dec_dict(o->u.d); break;
default: break;
}
}
}

void inc(Object *o) {
if (o->flags & COMP) {
switch(o->type) {
case stringtype: inc_string(o->u.s); break;
case arraytype: inc_array(o->u.a); break;
case dicttype: inc_dict(o->u.d); break;
default: break;
}
}
}

Object executable (Object o) { o.flags |= EXEC; return o; }

Object operator (char *name, void (*fp)()) {
Object o = { .type = operatortype, .flags = EXEC,
.u.op = { .name = name, .fp = fp } };
return o; }

/* eof: object.c */


luXer-ex-troglodyte
 
B

Ben Bacarisse

Aha. The macros really did get in the way.
It obfuscated the bug that inc(Object *o)
was actually killing the object instead
of incrementing. Really Bad!

I'd like to take the time to apologise for
the mess of code I dumped in your laps.

From the artifacts of splitting the program
into modules (the commented-out #includes),
to the unused macros, to the unnecessary
macros that concealed a bug which would
have become obvious before typing it a third
time.

The fact anyone was willing and able to
wade through it in the attempt to be helpful
is a testiment to their kindness and keenness.

That is very gracious and as such all to rare around here lately.
Here is the revised version, only the "real" X-macros
and defined constants remain:

I have another remark that I somehow lost from my last post:

/* Object Allocators and Convenience Functions */

Object boolean (char b) {
Object o = { .type = booleantype, .flags = 0, .u.b = b };
return o; }

Since you already require C99 (the designated initialisers) you might
as well write a compound literal:

return (Object){ .type = booleantype, .flags = 0, .u.b = b };

and avoid the automatic variable.
 
M

mijoryx

(e-mail address removed) writes:
I have another remark that I somehow lost from my last post:




Since you already require C99 (the designated initialisers) you might
as well write a compound literal:

       return (Object){ .type = booleantype, .flags = 0, .u.b = b };

and avoid the automatic variable.

Ooo. Pretty.
Thank you.

l-x-t
 
R

Richard Bos

Very cool. I think I see newt's-eyes and bat-wings.
That should help sweeten the broth (and add some chewy
bits). Now, can you use a cat to uproot a mandrake or does it have to
be a dog?

IMO it is better to use a cat. Sure, it may cause the cat's brains (or
whatever it has instead of brains) to dribble out of its ears, but at
least that means one fewer vermin on this world.

Richard
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Members online

No members online now.

Forum statistics

Threads
473,744
Messages
2,569,484
Members
44,903
Latest member
orderPeak8CBDGummies

Latest Threads

Top