Skip to content

Commit 0658188

Browse files
codybartfastcodybartfast
committed
Add: register
1 parent d43a93b commit 0658188

File tree

8 files changed

+175
-143
lines changed

8 files changed

+175
-143
lines changed

‎.vscode/tasks.json‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -31,6 +31,7 @@
3131
"src/parser.c",
3232
"src/pict.c",
3333
"src/primproc.c",
34+
"src/register.c",
3435
"src/sicp.c",
3536
"src/storage.c",
3637
"src/strbldr.c",

‎src/ambeval.c‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,7 @@
99
#include "list.h"
1010
#include "mceval.h"
1111
#include "parser.h"
12+
#include "register.h"
1213
#include "storage.h"
1314

1415
static obj is_amb_p(obj args)

‎src/aneval.c‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -10,6 +10,7 @@
1010
#include "mceval.h"
1111
#include "parser.h"
1212
#include "primproc.h"
13+
#include "register.h"
1314
#include "storage.h"
1415

1516
static obj is_and_p(obj args)

‎src/eceval.c‎

Lines changed: 2 additions & 138 deletions
Original file line numberDiff line numberDiff line change
@@ -9,29 +9,11 @@
99
#include "mceval.h"
1010
#include "output.h"
1111
#include "primproc.h"
12+
#include "register.h"
1213
#include "storage.h"
1314

1415
#define AREA "ECEVAL"
1516

16-
struct core {
17-
obj argl; // 1
18-
obj cont; // 2
19-
obj env; // 3
20-
obj expr; // 4
21-
obj proc; // 5
22-
obj stack; // 6
23-
obj unev; // 7
24-
obj val; // 8
25-
} cre;
26-
struct core *cr0 = &cre;
27-
28-
// the_global_environment // 9
29-
obj anenv; // 10
30-
obj ambenv; // 11
31-
obj savetmp; // 12
32-
33-
const int rootlen = 12;
34-
static obj rootlst;
3517

3618
// ln 182
3719
static obj empty_arglist(void)
@@ -87,89 +69,6 @@ static obj restore(struct core *cr)
8769
}
8870

8971
// used for garbage collection
90-
obj getroot(void)
91-
{
92-
int actlen;
93-
obj lst = rootlst;
94-
95-
// intentionally not using rootlen here, change number manually after
96-
// modifying body below.
97-
if ((actlen = length_u(rootlst)) != 12) {
98-
error_internal(
99-
AREA,
100-
"Bug! getroot() got list of unexpected length: %d ",
101-
actlen);
102-
exit(1);
103-
}
104-
// order must match setroot
105-
set_car(lst, cr0->argl);
106-
lst = cdr(lst);
107-
set_car(lst, cr0->cont);
108-
lst = cdr(lst);
109-
set_car(lst, cr0->env);
110-
lst = cdr(lst);
111-
set_car(lst, cr0->expr);
112-
lst = cdr(lst);
113-
set_car(lst, cr0->proc);
114-
lst = cdr(lst);
115-
set_car(lst, cr0->stack);
116-
lst = cdr(lst);
117-
set_car(lst, cr0->unev);
118-
lst = cdr(lst);
119-
set_car(lst, cr0->val);
120-
lst = cdr(lst);
121-
set_car(lst, the_global_environment());
122-
lst = cdr(lst);
123-
set_car(lst, anenv);
124-
lst = cdr(lst);
125-
set_car(lst, ambenv);
126-
lst = cdr(lst);
127-
set_car(lst, savetmp);
128-
129-
return rootlst;
130-
}
131-
132-
// used for garbage collection
133-
obj setroot(obj rlst)
134-
{
135-
int actlen;
136-
obj lst = rootlst = rlst;
137-
138-
// intentionally not using rootlen here, change number manually after
139-
// modifying body below.
140-
if ((actlen = length_u(rootlst)) != 12) {
141-
return error_internal(
142-
AREA,
143-
"Bug! setroot() got list of unexpected length: %d",
144-
actlen);
145-
}
146-
// order must match getroot
147-
cr0->argl = car(lst);
148-
lst = cdr(lst);
149-
cr0->cont = car(lst);
150-
lst = cdr(lst);
151-
cr0->env = car(lst);
152-
lst = cdr(lst);
153-
cr0->expr = car(lst);
154-
lst = cdr(lst);
155-
cr0->proc = car(lst);
156-
lst = cdr(lst);
157-
cr0->stack = car(lst);
158-
lst = cdr(lst);
159-
cr0->unev = car(lst);
160-
lst = cdr(lst);
161-
cr0->val = car(lst);
162-
lst = cdr(lst);
163-
set_global_environment(car(lst));
164-
lst = cdr(lst);
165-
anenv = car(lst);
166-
lst = cdr(lst);
167-
ambenv = car(lst);
168-
lst = cdr(lst);
169-
savetmp = car(lst);
170-
171-
return unspecified;
172-
}
17372

17473
static obj proc_name;
17574
static void set_proc_name(struct core *cr)
@@ -181,43 +80,8 @@ static void set_proc_name(struct core *cr)
18180
of_string("<unknown>");
18281
}
18382

184-
static bool initdone = false;
185-
static obj init(void)
186-
{
187-
int actlen;
188-
189-
cr0->stack = emptylst;
190-
// preallocate storage for gc root
191-
rootlst = listn(12, // <----- actual length
192-
unspecified, // 1
193-
unspecified, // 2
194-
unspecified, // 3
195-
unspecified, // 4
196-
unspecified, // 5
197-
unspecified, // 6
198-
unspecified, // 7
199-
unspecified, // 8
200-
unspecified, // 9
201-
unspecified, // 10
202-
unspecified, // 11
203-
unspecified // 12
204-
);
205-
if ((actlen = length_u(rootlst)) != rootlen) {
206-
error_internal(
207-
AREA,
208-
"Bug! init, root wrong length. is: %d, expected %d",
209-
actlen, rootlen);
210-
exit(1);
211-
}
212-
initdone = true;
213-
return unspecified;
214-
}
215-
21683
static obj ecevalcr(obj expression, obj _environment, struct core *cr)
21784
{
218-
if (!initdone) {
219-
init();
220-
}
22185
cr->expr = expression;
22286
cr->env = _environment;
22387
cr->cont = ev_return_caller;
@@ -588,5 +452,5 @@ static obj ecevalcr(obj expression, obj _environment, struct core *cr)
588452

589453
obj eceval(obj expression, obj _environment)
590454
{
591-
return ecevalcr(expression, _environment,cr0);
455+
return ecevalcr(expression, _environment, dfltcore());
592456
}

‎src/eceval.h‎

Lines changed: 0 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -4,10 +4,6 @@
44

55
#include "obj.h"
66

7-
extern obj anenv;
8-
extern obj ambenv;
97
obj eceval(obj exp, obj env);
10-
obj getroot(void);
11-
obj setroot(obj);
128

139
#endif

‎src/register.c‎

Lines changed: 143 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,143 @@
1+
#include "register.h"
2+
3+
#include <stdlib.h>
4+
#include "environment.h"
5+
#include "error.h"
6+
#include "list.h"
7+
8+
#define AREA "REGISTER"
9+
10+
struct core core0;
11+
struct core *cr0 = &core0;
12+
13+
// tge // 9
14+
obj anenv; // 10
15+
obj ambenv; // 11
16+
obj savetmp; // 12
17+
18+
const int rootlen = 12;
19+
static obj rootlst;
20+
21+
obj getroot(void)
22+
{
23+
int actlen;
24+
obj lst = rootlst;
25+
26+
// intentionally not using rootlen here, change number manually after
27+
// modifying body below.
28+
if ((actlen = length_u(rootlst)) != 12) {
29+
error_internal(
30+
AREA,
31+
"Bug! getroot() got list of unexpected length: %d ",
32+
actlen);
33+
exit(1);
34+
}
35+
// order must match setroot
36+
set_car(lst, cr0->argl);
37+
lst = cdr(lst);
38+
set_car(lst, cr0->cont);
39+
lst = cdr(lst);
40+
set_car(lst, cr0->env);
41+
lst = cdr(lst);
42+
set_car(lst, cr0->expr);
43+
lst = cdr(lst);
44+
set_car(lst, cr0->proc);
45+
lst = cdr(lst);
46+
set_car(lst, cr0->stack);
47+
lst = cdr(lst);
48+
set_car(lst, cr0->unev);
49+
lst = cdr(lst);
50+
set_car(lst, cr0->val);
51+
lst = cdr(lst);
52+
set_car(lst, the_global_environment());
53+
lst = cdr(lst);
54+
set_car(lst, anenv);
55+
lst = cdr(lst);
56+
set_car(lst, ambenv);
57+
lst = cdr(lst);
58+
set_car(lst, savetmp);
59+
60+
return rootlst;
61+
}
62+
63+
// used for garbage collection
64+
obj setroot(obj rlst)
65+
{
66+
int actlen;
67+
obj lst = rootlst = rlst;
68+
69+
// intentionally not using rootlen here, change number manually after
70+
// modifying body below.
71+
if ((actlen = length_u(rootlst)) != 12) {
72+
return error_internal(
73+
AREA,
74+
"Bug! setroot() got list of unexpected length: %d",
75+
actlen);
76+
}
77+
// order must match getroot
78+
cr0->argl = car(lst);
79+
lst = cdr(lst);
80+
cr0->cont = car(lst);
81+
lst = cdr(lst);
82+
cr0->env = car(lst);
83+
lst = cdr(lst);
84+
cr0->expr = car(lst);
85+
lst = cdr(lst);
86+
cr0->proc = car(lst);
87+
lst = cdr(lst);
88+
cr0->stack = car(lst);
89+
lst = cdr(lst);
90+
cr0->unev = car(lst);
91+
lst = cdr(lst);
92+
cr0->val = car(lst);
93+
lst = cdr(lst);
94+
set_global_environment(car(lst));
95+
lst = cdr(lst);
96+
anenv = car(lst);
97+
lst = cdr(lst);
98+
ambenv = car(lst);
99+
lst = cdr(lst);
100+
savetmp = car(lst);
101+
102+
return unspecified;
103+
}
104+
105+
static bool initdone = false;
106+
static obj init(void)
107+
{
108+
int actlen;
109+
110+
cr0->stack = emptylst;
111+
// preallocate storage for gc root
112+
rootlst = listn(12, // <----- actual length
113+
unspecified, // 1
114+
unspecified, // 2
115+
unspecified, // 3
116+
unspecified, // 4
117+
unspecified, // 5
118+
unspecified, // 6
119+
unspecified, // 7
120+
unspecified, // 8
121+
unspecified, // 9
122+
unspecified, // 10
123+
unspecified, // 11
124+
unspecified // 12
125+
);
126+
if ((actlen = length_u(rootlst)) != rootlen) {
127+
error_internal(
128+
AREA,
129+
"Bug! init, root wrong length. is: %d, expected %d",
130+
actlen, rootlen);
131+
exit(1);
132+
}
133+
initdone = true;
134+
return unspecified;
135+
}
136+
137+
struct core *dfltcore(void)
138+
{
139+
if (!initdone) {
140+
init();
141+
}
142+
return cr0;
143+
}

‎src/register.h‎

Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,26 @@
1+
#ifndef REGISTER_H
2+
#define REGISTER_H
3+
#include "sicpstd.h"
4+
5+
#include "obj.h"
6+
7+
struct core {
8+
obj argl;
9+
obj cont;
10+
obj env;
11+
obj expr;
12+
obj proc;
13+
obj stack;
14+
obj unev;
15+
obj val;
16+
};
17+
18+
struct core *dfltcore(void);
19+
20+
extern obj anenv;
21+
extern obj ambenv;
22+
extern obj savetmp;
23+
24+
obj getroot(void);
25+
obj setroot(obj);
26+
#endif

‎src/storage.c‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,8 @@
11
#include "storage.h"
22

33
#include <stdlib.h>
4-
#include "eceval.h"
54
#include "list.h"
5+
#include "register.h"
66

77
#define AREA "STORAGE"
88

0 commit comments

Comments
 (0)