problem
peg — a peg represents a gc pointer to box object in toy programming language lathe (a lisp dialect plus smalltalk class system, using þ library under mu, using the mu-babel license.) The stack demo mentioned pegs. (Updates? See toy.)
A peg is an instance of struct yp whose name means thorn (gc) pointer, and is used as the most generic form of value stored in garbage collected memory. A peg is the same size as void* because it contains a pointer inside. Actually, this pointer field occurs inside a union overlaying the pointer with an integer field, in case the peg is used to hold an immediate value packed in the integer.
So a peg either contains an immediate value or a box pointer — one or the other — and is the same size as void*: 32 bits on a 32-bit system. (One might also manage to use only 32 bits in a 64-bit system, but we won't discuss that.)
Vectors in lisp and arrays in smalltalk are examples of objects containing other values (typically) by reference; a vector box is physically a sequence of N yp pegs for a vector of length N. And a pair box (ie a cons cell in lisp) is a pair of yp pegs named car and cdr in the Scheme bindings. Like this:
struct ypairb { // pair box: two pegs; a Lisp cons cell «
yp b_car; // conventional lisp car: pair's first
yp b_cdr; // conventional lisp cdr: pair's second
// lots of pair api omitted here (real api? see box)
};
The point of peg struct yp (shown below) is to support this use in box structs: a generic value slot of uniform size and api. Yes, instead of struct yp, these slots in objects could just be some pointer type, with appropriate casting everywhere used — slicing and dicing with wild abandon in good C style. That would work. But the compiler wouldn't provide the slightest bit of help in detecting mistakes. And pegs will be used everywhere, pervasively, thus the short name. Nervous?
Making Wil think: this first version of lathe might have fewer bugs if a struct with api is used instead for each peg. Maybe the same efficient code will be emitted with inlines. If not, Wil can always rev the peg format later to a more hazardous form, with tests written that pass in the old version using yp. First get it done, and right; then worry about speed. (Wil did it the gnarly C way years ago in an old rev; it's tedious.)
menu
mu, toy, peg « Þ, imm, tag, box, symbol, token, number, bigint, class, method, reader, writer, eval, env, vm, gc, world, pcode, compiler, asm, lathe, lisp, smalltalk, design, weight, jar, card, harp, debug, profile
(thorn, todo, names, fd, iovec, assert, log, run, hex, crc, buf, in, out, quote, escape, compare, file, deck, cow, arc, blob, tree, slice, rand, time, stat, hash, heap, node, primes, page, book, pile, stack, atomic, lock, mutex, thread, map, meter, list, iter, ctype)
/* 3 2 1 «
1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
| value |--ply--:cue:ilk|
+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
| | | | | | | |
ply bits ----------------------o-o-o-o | | | |
| | | |
cue bits ------------------------------o-o | |
| |
ilk bits ----------------------------------o-o
**/
typedef ptrdiff_t p_t; // ptr type converts to int for masks «
typedef i32 lid_t; // sizeof(lid_t) must be >= sizeof(void*) «
union { // overlay low order tag bits with high order values
ybox* p_box; // the pointer when a peg holds a pointer «
lid_t p_lid; // all (32) bits as single int «
} u; // union «
enum Pply { // cue==c_ply==0 «
p_false = 0, p_true, p_void, p_none, // 0..3
p_one, p_two, p_three, p_nobox, // 4..7 unused
p_next, p_rest, p_key, p_val, // 8..b
p_eof, p_setter, p_getter, p_token // c..f
};
enum Psole { // special "sole" constants put into p_lid «
// p_lid constants (shifted by 4 to reach ply bits)
s_nil = i_nil,
s_false = ((p_false << 4) | i_cue), // c_ply == 0
s_true = ((p_true << 4) | i_cue), // c_ply == 0
s_void = ((p_void << 4) | i_cue), // c_ply == 0
s_none = ((p_none << 4) | i_cue), // c_ply == 0
s_next = ((p_next << 4) | i_cue), // c_ply == 0
s_rest = ((p_rest << 4) | i_cue), // c_ply == 0
s_key = ((p_key << 4) | i_cue), // c_ply == 0
s_val = ((p_val << 4) | i_cue), // c_ply == 0
s_eof = ((p_eof << 4) | i_cue), // c_ply == 0
};
enum Pquad { // least significant 4-bits of p_lid «
q_c21 = ((c_chr << 2) | i_cue),
q_err = ((c_err << 2) | i_cue)
};
enum Perr { // cue==c_err==2 (error immediates) «
r_cease = 0, // eof encountered unexpectedly at line
r_delim, // wrong delimitor at line (paren vs bracket)
r_overdot, // too many expressions after dot in list
r_underdot, // missing expression after dot in list
r_multidot, // multiple dots in same list
r_badref, // #n= or #n# refs nothing when n is unknown
};
enum Poct { // least significant 8-bits of p_lid «
// no need to include (c_ply << 2) when c_ply is zero:
o_nobox = ((p_nobox << 4) | i_cue), // | (c_ply << 2)
o_setter = ((p_setter << 4) | i_cue), // | (c_ply << 2)
o_getter = ((p_getter << 4) | i_cue), // | (c_ply << 2)
o_token = ((p_token << 4) | i_cue), // | (c_ply << 2)
// must use (c_err << 2) with i_cue: c_err is NOT zero:
o_cease = ((r_cease << 4) | q_err),
o_delim = ((r_delim << 4) | q_err),
o_overdot = ((r_overdot << 4) | q_err),
o_underdot = ((r_underdot << 4) | q_err),
o_multidot = ((r_multidot << 4) | q_err),
o_badref = ((r_badref << 4) | q_err),
};
explicit yp(u32 v) { u.p_lid = v; } «
bool operator==(yp const& p) const { «
return p.u.p_box == u.p_box; }
bool operator!=(yp const& p) const { «
return p.u.p_box != u.p_box; }
u32 operator=(u32 v) { u.p_lid = v; return v; } «
bool operator==(u32 v) const { return v == u.p_lid; } «
bool operator!=(u32 v) const { return v != u.p_lid; } «
explicit yp(ybox* b) { u.p_box = b; } «
explicit yp(Pilk i) { u.p_lid = i; } «
explicit yp(Psole s) { u.p_lid = s; } «
u32 operator=(Pilk i) { u.p_lid = i; return i; } «
u32 xilk(Pilk i) { u.p_lid = i; return i; } «
bool operator==(Pilk i) const { return i == u.p_lid; } «
bool operator!=(Pilk i) const { return i != u.p_lid; } «
u32 operator=(Psole s) { u.p_lid = s; return s; } «
u32 xsole(Psole s) { u.p_lid = s; return s; } «
bool operator==(Psole s) const { return s == u.p_lid; } «
bool operator!=(Psole s) const { return s != u.p_lid; } «
/// \return not zero and not nil
bool nonnil() const { // peg type is not nil? «
return u.p_lid && (i_nil != u.p_lid);
}
// tlid() asks "is a lid peg?" (an imm? nonzero low bits?)
bool tlid() const { return (3 & (p_t) u.p_box) != 0; } «
lid_t plid() const { return u.p_lid; } // encoding of imm «
operator lid_t() const { return u.p_lid; } // the lid bits «
// tbox() asks "is a box peg?" (not imm? zero low bits?)
bool tbox() const { return (3 & (p_t) u.p_box) == 0; } «
ybox* pbox() const { return u.p_box; } // 4-byte aligned «
operator ybox*() const { return u.p_box; } // the ptr bits «
void xbox(const void* b) { u.p_box = (ybox*) (void*) b; } «
yt ptag() const { // tag for box, if it's really a box «
yt t;
if ( u.p_box && (3 & (p_t) u.p_box) == 0 )
t = ((const yt*) u.p_box)[-1];
return t;
}
bool operator==(ybox* b) const { return b == u.p_box; } «
bool operator!=(ybox* b) const { return b != u.p_box; } «
// peg type is imm int? (low bits are equal to one?)
bool ti4() const { return (3 & u.p_lid) == i_int; } «
int pi4() const { return u.p_lid >> 2; } // remove ilk bits «
void xi4(int x) { u.p_lid = (x << 2) | i_int; } «
// 30-bit ints use 30th bit for sign; only 29 bits remain:
enum { // limits of immediate integers
// e_i4max = 0x1fffffff (29 bits)
e_i4max = (1<<29)-1, // biggest pos int preserved by xi4() «
// e_i4min = 0xe0000000 (30 bits)
e_i4min = (-1L<<29), // smallest neg int preserved by xi4() «
e_i4bits = 30 «
};
// e_i4max: biggest pos int from xi4(): 0x1fffffff (29 bits)
// e_i4min: smallest neg int from xi4(): 0xe0000000 (30 bits)
// peg type is err? (low 4 bits equal to quad err value?)
bool terr() const { return (u.p_lid & 0x0f) == q_err; } «
Perr perr() const { return (Perr) ((u.p_lid >> 4) & 0x0f); } «
u32 perrline() const { return (u32) (u.p_lid >> 8); } «
// peg type is cease? (low 8 bits equal to oct cease value?)
bool tcease() const { return (u.p_lid & 0x0ff) == o_cease; } «
u32 pceaseline() const { return (u32) (u.p_lid >> 8); } «
void xcease(u32 line) { u.p_lid = (line << 8) | o_cease; } «
// peg type is delim? (low 8 bits equal to oct delim value?)
bool tdelim() const { return (u.p_lid & 0x0ff) == o_delim; } «
u32 pdelimline() const { return (u32) (u.p_lid >> 8); } «
void xdelim(u32 line) { u.p_lid = (line << 8) | o_delim; } «
// type is overdot? (low 8 bits equal oct overdot val?)
bool toverdot() const { «
return (u.p_lid & 0x0ff) == o_overdot; }
u32 poverdotline() const { return (u32) (u.p_lid >> 8); } «
void xoverdot(u32 line) { «
u.p_lid = (line << 8) | o_overdot; }
bool tunderdot() const { «
return (u.p_lid & 0x0ff) == o_underdot; }
u32 punderdotline() const { return (u32) (u.p_lid >> 8); } «
void xunderdot(u32 line) { «
u.p_lid = (line << 8) | o_underdot; }
bool tmultidot() const { «
return (u.p_lid & 0x0ff) == o_multidot; }
u32 pmultidotline() const { return (u32) (u.p_lid >> 8); } «
void xmultidot(u32 line) { «
u.p_lid = (line << 8) | o_multidot; }
bool tbadref() const { return (u.p_lid & 0x0ff)==o_badref; } «
u32 pbadrefline() const { return (u32) (u.p_lid >> 8); } «
void xbadref(u32 line) { u.p_lid = (line << 8) | o_badref; } «
bool tc21() const { return (u.p_lid & 0x0f) == q_c21; } «
c32 pc21() const { return (c32) (u.p_lid >> 8); } «
// peg bucky bits (second four bits):
int pbucky() const { return (u.p_lid >> 4) & 0x0f; } «
void xc(c32 c) { u.p_lid = (c << 8) | q_c21; } «
void xc21(c32 c) { u.p_lid = (c << 8) | q_c21; } «
void xc21(c32 c, int bucky) { «
u.p_lid = (c << 8) | ((bucky & 0x0f) << 4) | q_c21;
}
// char->integer according to MIT Scheme with bucky bits:
i32 pc21asinteger() const { c32 lid = u.p_lid; «
int bucky = (lid >> 4) & 0x0f; // ply bits
return (i32) ((bucky << 21) | (u.p_lid >> 8));
}
bool tnobox() const { return o_nobox == (u.p_lid & 0xff); } «
u_t pnobox() const { return (u_t) (u.p_lid >> 8); } «
void xnobox(u_t tag) { u.p_lid = (tag << 8) | o_nobox; } «
bool tsetter() const { return o_setter == (u.p_lid & 0xff); } «
u_t psetter() const { return (u_t) (u.p_lid >> 8); } «
void xsetter(u_t x) { u.p_lid = (x << 8) | o_setter; } «
bool tgetter() const { return o_getter == (u.p_lid & 0xff); } «
u_t pgetter() const { return (u_t) (u.p_lid >> 8); } «
void xgetter(u_t x) { u.p_lid = (x << 8) | o_getter; } «
bool ttoken() const { return o_token == (u.p_lid & 0xff); } «
u_t ptoken() const { return (u_t) (u.p_lid >> 8); } «
void xtoken(u_t x) { u.p_lid = (x << 8) | o_token; } «
struct Pq { yp const& q_p; Pq(yp const& p): q_p(p) { } }; «
Pq quote() const { return Pq(*this); } // for pretty printer «
void pprint() const; // dump to stdout via yout
void pdump(yo& o) const; void pcite(yo& o) const;
static void _pcitebox(const void* b, yo& o);
}; // struct yp
inline yo& operator<<(yo& o, yp const& x) { «
x.pdump(o); return o; }
inline yo& operator<<(yo& o, yp::Pq const& x) { «
x.q_p.pdump(o); return o; }
inline bool operator==(u32 v, yp const& p) { «
return v == p.u.p_lid; }
inline bool operator!=(u32 v, yp const& p) { «
return v != p.u.p_lid; }
inline bool operator==(yp::Pilk i, yp const& p) { «
return i == p.u.p_lid; }
inline bool operator!=(yp::Pilk i, yp const& p) { «
return i != p.u.p_lid; }
inline bool operator==(void* b, yp const& p) { «
return b == p.u.p_box; }
inline bool operator!=(void* b, yp const& p) { «
return b != p.u.p_box; }
void yp::pcite(yo& o) const { «
const yp& peg = *this;
u32 lid = peg.plid();
switch (lid & 3) { // low two 'ilk' bits:
case yp::i_box: yp::_pcitebox(peg.pbox(), o); break;
case yp::i_int: o.of("%d", (int) peg.pi4()); break;
case yp::i_nil: o.o2c('(', ')'); break;
case yp::i_cue: { // need to look at ecue bits
switch ((lid >> 2) & 3) { // ecue enum bits
case yp::c_ply: { // need to look at Pply bits
switch ((lid >> 4) & 0x0f) { // Pply enum bits
case yp::p_false: o.o2c('#', 'f'); break;
case yp::p_true: o.o2c('#', 't'); break;
case yp::p_void: o << "#void"; break;
case yp::p_none: o << "#none"; break;
case yp::p_one:
o.of("#<p_one lid=0x%lx>", (long) lid); break;
case yp::p_two:
o.of("#<p_two lid=0x%lx>", (long) lid); break;
case yp::p_three:
o.of("#<p_three lid=0x%lx>", (long) lid); break;
case yp::p_nobox: {
yt tag(peg.pnobox());
o.of("#<nobox %s>", tag.tname()); break;
}
case yp::p_next: o << "#next"; break;
case yp::p_rest: o << "#rest"; break;
case yp::p_key: o << "#key"; break;
case yp::p_val: o << "#val"; break;
case yp::p_eof: o << "#eof"; break;
case yp::p_setter:
o.of("#<setter i=%u>", peg.psetter()); break;
case yp::p_getter:
o.of("#<getter i=%u>", peg.pgetter()); break;
case yp::p_token: { int tok = peg.ptoken();
o.of("#<token cd=%d nm=%s>", tok,
asName((yi2br::etoken) tok));
break;
}
default: // should be unreachable
o.of("#<c_ply lid=0x%lx>", (long) lid); break;
} // switch ((lid >> 4) & 0x0f) { // Pply enum bits
break;
} // case yp::c_ply
case yp::c_one:
o.of("#<c_one lid=0x%lx>", (long) lid); break;
case yp::c_err: {
int line = (int) peg.perrline();
yp::Perr e = peg.perr();
switch (e) {
case yp::r_cease:
// hit eof before end of some expression
o.of("#<unexpected-eof line=%d>", line); break;
case yp::r_delim:
// hit paren or bracket mixup for delimit end
o.of("#<wrong-delimitor line=%d>", line); break;
case yp::r_overdot: // too many expr's after dot
o.of("#<extra-expr-post-dot line=%d>", line);
break;
case yp::r_underdot: // missing expr after dot
o.of("#<missing-expr-post-dot line=%d>", line);
break;
case yp::r_multidot:
// too many dots in one list
o.of("#<multiple-list-dots line=%d>", line);
break;
case yp::r_badref:
// #n= or #n# refers to nothing if n is unknown
o.of("#<badref n=%d in='#n= or #n# ref'>", line);
break;
default:
o.of("#<err kind=0x%x line=%d>", (int) e, line);
break;
}
} // yp::c_err
case yp::c_chr: {
c32 c = peg.pc21(); int bucky = peg.pbucky();
const char* cname = yb2ow::wcname(c);
if (bucky) // any bucket bits are set? (stub)
o.of("#<char #\\u+%x bucky=0x%x>", (int) c, bucky);
else if (cname) {
o.o2c('#', '\\'); o << cname;
}
else if (c <= 0x7F) // no more than 7-bits?
o.o3c('#', '\\', (u8) c);
else // unicode codepoint
o.of("#\\u+%x", (int) c);
}
default: // should be unreachable
o.of("#<i_cue lid=0x%lx>", (long) lid); break;
} // switch ((lid >> 2) & 3) { // ecue enum bits
break;
} // case yp::i_cue
default: // should be unreachable
o.of("#<yp::pcite lid=0x%lx>", (long) lid); break;
} // switch (lid & 3) for ilk bits
}
void yp::_pcitebox(const void* b, yo& o) { «
// box pointer to w_no or w_o
// char buf[128];
yt tag = ybox::btag(b);
long plx = (long) b; // b as long for p=%lx print format
switch (tag.kind()) {
case yt::k_none: { o.of("#<none p=%lx>", plx); return; }
case yt::k_p1: { o.of("#<1-tuple p=%lx>", plx); return; }
case yt::k_p2: {
const ypairb& p2 = *(const ypairb*) b;
o.of("#<pair car='%lx' cdr='%lx'>",
(long) p2.b_car.pbox(), p2.b_cdr.pbox());
return;
}
case yt::k_p3: { o.of("#<triple p=%lx>", plx); return; }
case yt::k_p4: { o.of("#<quad p=%lx>", plx); return; }
case yt::k_hash: { o.of("#<hash p=%lx>", plx); return; }
case yt::k_r128: { o.of("#<r128 p=%lx>", plx); return; }
case yt::k_i128: { o.of("#<r128 p=%lx>", plx); return; }
case yt::k_i16: { o.of("#<i16 p=%lx>", plx); return; }
case yt::k_u16: { o.of("#<u16 p=%lx>", plx); return; }
case yt::k_i32: { o.of("#<i32 p=%lx>", plx); return; }
case yt::k_u32: { o.of("#<u32 p=%lx>", plx); return; }
case yt::k_i64: { o.of("#<i64 p=%lx>", plx); return; }
case yt::k_u64: { o.of("#<u64 p=%lx>", plx); return; }
case yt::k_r32: { o.of("#<r32 p=%lx>", plx); return; }
case yt::k_r64: { o.of("#<r64 p=%lx>", plx); return; }
case yt::k_vec: { o.of("#<vector p=%lx>", plx); return; }
case yt::k_obj: { o.of("#<object p=%lx>", plx); return; }
case yt::k_class: { o.of("#<class p=%lx>", plx); return; }
case yt::k_int: { o.of("#<bigint p=%lx>", plx); return; }
case yt::k_tree: { o.of("#<tree p=%lx>", plx); return; }
case yt::k_cord: { o.of("#<cord p=%lx>", plx); return; }
case yt::k_sym: { o.of("#<sym p=%lx>", plx); return; }
case yt::k_far: { o.of("#<far p=%lx>", plx); return; }
case yt::k_map: { o.of("#<map p=%lx>", plx); return; }
case yt::k_row: { o.of("#<row p=%lx>", plx); return; }
case yt::k_rig: { o.of("#<rig p=%lx>", plx); return; }
// return this->trigname();
case yt::k_toc: { o.of("#<toc p=%lx>", plx); return; }
case yt::k_iter: { o.of("#<iter p=%lx>", plx); return; }
case yt::k_table: { o.of("#<table p=%lx>", plx); return; }
case yt::k_fore: { o.of("#<fore p=%lx>", plx); return; }
case yt::k_back: { o.of("#<back p=%lx>", plx); return; }
} // switch
o.of("#<BOX p=%lx kind=#%lx>", plx, (long) tag.kind());
}
