test: Split-up Mescc scaffold test.
[mes.git] / scaffold / tests / 64-make-cell.c
1 /* -*-comment-start: "//";comment-end:""-*-
2  * Mes --- Maxwell Equations of Software
3  * Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
4  *
5  * This file is part of Mes.
6  *
7  * Mes is free software; you can redistribute it and/or modify it
8  * under the terms of the GNU General Public License as published by
9  * the Free Software Foundation; either version 3 of the License, or (at
10  * your option) any later version.
11  *
12  * Mes is distributed in the hope that it will be useful, but
13  * WITHOUT ANY WARRANTY; without even the implied warranty of
14  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15  * GNU General Public License for more details.
16  *
17  * You should have received a copy of the GNU General Public License
18  * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
19  */
20
21 #include "30-test.i"
22
23 #include <stdio.h>
24 #include <stdlib.h>
25 #include <string.h>
26
27 struct scm {
28   int type;
29   int car;
30   int cdr;
31 };
32
33 int bla = 1234;
34 char g_arena[84];
35 #if __MESC__
36 struct scm *g_cells = g_arena;
37 #else
38 struct scm *g_cells = (struct scm*)g_arena;
39 #endif
40 char *g_chars = g_arena;
41
42 int foo () {puts ("t: foo\n"); return 0;};
43 int bar (int i) {puts ("t: bar\n"); return 0;};
44 struct function {
45   int (*function) (void);
46   int arity;
47   char *name;
48 };
49 struct function g_fun = {&exit,1,"fun"};
50 struct function g_foo = {&foo,0,"foo"};
51 struct function g_bar = {&bar,1,"bar"};
52
53 //void *functions[2];
54 int functions[2];
55
56 struct function g_functions[2];
57 int g_function = 0;
58
59 enum type_t {TCHAR, TCLOSURE, TCONTINUATION, TFUNCTION, TKEYWORD, TMACRO, TNUMBER, TPAIR, TREF, TSPECIAL, TSTRING, TSYMBOL, TVALUES, TVECTOR, TBROKEN_HEART};
60
61 typedef int SCM;
62 int g_free = 3;
63 SCM tmp;
64 SCM tmp_num;
65
66 int ARENA_SIZE = 200;
67 #define TYPE(x) g_cells[x].type
68 #define CAR(x) g_cells[x].car
69 #define CDR(x) g_cells[x].cdr
70 #define VALUE(x) g_cells[x].cdr
71
72 #define CAAR(x) CAR (CAR (x))
73
74 struct scm scm_fun = {TFUNCTION,0,0};
75 SCM cell_fun;
76
77 SCM
78 alloc (int n)
79 {
80   SCM x = g_free;
81   g_free += n;
82   return x;
83 }
84
85 SCM
86 make_cell (SCM type, SCM car, SCM cdr)
87 {
88   SCM x = alloc (1);
89   TYPE (x) = VALUE (type);
90   if (VALUE (type) == TCHAR || VALUE (type) == TNUMBER) {
91     if (car) CAR (x) = CAR (car);
92     if (cdr) CDR(x) = CDR(cdr);
93   }
94   else if (VALUE (type) == TFUNCTION) {
95     if (car) CAR (x) = car;
96     if (cdr) CDR(x) = CDR(cdr);
97   }
98   else {
99     CAR (x) = car;
100     CDR(x) = cdr;
101   }
102   return x;
103 }
104
105 SCM
106 make_cell_test ()
107 {
108   VALUE (tmp_num) = TPAIR;
109   make_cell (tmp_num, 0, 1);
110   return 0;
111 }
112
113 SCM
114 make_tmps_test (struct scm* cells)
115 {
116   puts ("t: tmp = g_free++\n");
117   tmp = g_free++;
118   puts ("t: cells[tmp].type = CHAR\n");
119   cells[tmp].type = TCHAR;
120   tmp_num = g_free++;
121   cells[tmp_num].type = TNUMBER;
122
123   return 0;
124 }
125
126 int
127 test ()
128 {
129   puts ("\n");
130   make_tmps_test (g_cells);
131   make_cell_test ();
132   return 0;
133 }