andrius
/
mes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

core: Prepare for M2-Planet: struct.c. 

* src/struct.c: Rewrite C constructs not supported by M2-Planet.
This commit is contained in:
Jan Nieuwenhuizen 2019-10-20 13:39:12 +02:00
parent d999009783
commit 192d31d656
No known key found for this signature in database
GPG Key ID: F3C1A0D9C1D65273
1 changed files with 14 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
src/struct.c
View File

@ -29,9 +29,16 @@ make_struct (SCM type, SCM fields, SCM printer)
long size = 2 + length__ (fields);
SCM v = alloc (size);
SCM x = make_cell__ (TSTRUCT, size, v);
g_cells[v] = g_cells[vector_entry (type)];
g_cells[v + 1] = g_cells[vector_entry (printer)];
for (long i = 2; i < size; i++)
SCM vt = vector_entry (type);
TYPE (v) = TYPE (vt);
CAR (v) = CAR (vt);
CDR (v) = CDR (vt);
SCM vp = vector_entry (printer);
TYPE (v + 1) = TYPE (vp);
CAR (v + 1) = CAR (vp);
CDR (v + 1) = CDR (vp);
long i;
for (i = 2; i < size; i = i + 1)
{
SCM e = cell_unspecified;
if (fields != cell_nil)
@ -39,7 +46,10 @@ make_struct (SCM type, SCM fields, SCM printer)
e = CAR (fields);
fields = CDR (fields);
}
g_cells[v + i] = g_cells[vector_entry (e)];
SCM ve = vector_entry (e);
TYPE (v + i) = TYPE (ve);
CAR (v + i) = CAR (ve);
CDR (v + i) = CDR (ve);
}
return x;
}